home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / Foible / foible / Foible4.st < prev    next >
Text File  |  1993-07-24  |  97KB  |  3,780 lines
  1. 'From Tektronix Smalltalk-80 version T2.2.0cM3, of September 21, 1987 on 19 May 1990 at 1:55:55 pm'!
  2.  
  3. MouseMenuController subclass: #CanvasController
  4.     instanceVariableNames: 'tool saveCursor redButtonResult lastYellowButtonMessage '
  5.     classVariableNames: ''
  6.     poolDictionaries: ''
  7.     category: 'Foible'!
  8. CanvasController comment:
  9. 'I am the controller for a single canvas.
  10.  
  11. Instance variables:
  12.  
  13.     tool <Tool>
  14.     saveCursor <Cursor>
  15.     redButtonResult ?
  16.     lastYellowButtonMessage <Symbol>'!
  17.  
  18.  
  19. !CanvasController methodsFor: 'control defaults'!
  20.  
  21. isControlActive
  22.  
  23.     ^super isControlActive & (sensor blueButtonPressed not) &
  24.         tool isControlActive! !
  25.  
  26.  
  27. !CanvasController methodsFor: 'tool access'!
  28.  
  29. tool
  30.  
  31.     ^tool!
  32.  
  33. tool: aTool
  34.  
  35.     tool _ aTool.
  36.     tool initializeWithModel: self model 
  37.             view: self view 
  38.             controller: self.! !
  39.  
  40.  
  41. !CanvasController methodsFor: 'basic control sequence'!
  42.  
  43. controlInitialize
  44.     "Save old cursor, install new one"
  45.  
  46.     lastYellowButtonMessage = #createIcon "redraw display to show new icon"
  47.         ifTrue: 
  48.             [lastYellowButtonMessage _ nil.
  49.             view display].
  50.     saveCursor _ Cursor currentCursor.
  51.     model cursor show.
  52.     tool controlInitialize!
  53.  
  54. controlTerminate
  55.     "Restore old cursor"
  56.  
  57.     saveCursor show.
  58.     tool controlTerminate.! !
  59.  
  60.  
  61. !CanvasController methodsFor: 'accessing'!
  62.  
  63. redButtonResult
  64.     "return the result of the last RedButtonActivity"
  65.  
  66.     ^redButtonResult! !
  67.  
  68.  
  69. !CanvasController methodsFor: 'menu messages'!
  70.  
  71. menuMessageReceiver
  72.     "Answer the object that should be sent a message when a menu item is selected."
  73.     ^self tool!
  74.  
  75. redButtonActivity
  76.     "Keep result of redButtonActivity for later use.."
  77.  
  78.     redButtonResult _ self tool redButtonActivity!
  79.  
  80. yellowButtonActivity
  81.     "Determine which item in the yellow button pop-up menu  
  82.      is selected.   
  83.     If one is selected, then send the corresponding message   
  84.     to the object   
  85.     designated as the menu message receiver."
  86.  
  87.     | index |
  88.     yellowButtonMenu ~~ nil
  89.         ifTrue: 
  90.             [index _ yellowButtonMenu startUpYellowButton.
  91.             index ~= 0
  92.                 ifTrue: 
  93.                     [lastYellowButtonMessage _ yellowButtonMessages at: index.
  94.                     self menuMessageReceiver perform: lastYellowButtonMessage]]
  95.         ifFalse: [super controlActivity]! !
  96.  
  97.  
  98. ScrollController subclass: #PaletteController
  99.     instanceVariableNames: 'tools currentTool '
  100.     classVariableNames: ''
  101.     poolDictionaries: ''
  102.     category: 'Foible'!
  103. PaletteController comment:
  104. 'I am used to display a palette on the side of my View''s window. I inform 
  105. my View when a new icon has been selected in the palette.
  106.  
  107. Instance variables:
  108.  
  109.     tools <OrderedCollection>
  110.         a collection of the icons to display in the palette.
  111.     currentTool <Form>
  112.         the currently selected icon'!
  113.  
  114.  
  115. !PaletteController methodsFor: 'initialize-release'!
  116.  
  117. initialize
  118.     super initialize.
  119.     scrollBar _ Quadrangle new
  120.         borderWidthLeft: 2 right: 1 top: 2 bottom: 2! !
  121.  
  122.  
  123. !PaletteController methodsFor: 'basic control sequence'!
  124.  
  125. controlInitialize
  126.     | displayBox | 
  127.     displayBox _ view insetDisplayBox expandBy: 0@2.
  128.     scrollBar _ scrollBar align: scrollBar topRight with: displayBox topLeft.
  129.     savedArea _ Form fromDisplay: scrollBar.
  130.     scrollBar display.
  131.     self displayTools!
  132.  
  133. controlTerminate
  134.  
  135.     super controlTerminate.
  136.     Cursor normal show! !
  137.  
  138.  
  139. !PaletteController methodsFor: 'control defaults'!
  140.  
  141. isControlActive
  142.     ^super isControlActive & sensor blueButtonPressed not!
  143.  
  144. scrollActivity
  145.     sensor anyButtonPressed
  146.         ifTrue: [self selectTool]!
  147.  
  148. scrollLoop
  149.     Cursor normal show.
  150.     [self scrollBarContainsCursor]
  151.         whileTrue: 
  152.             [Processor yield.
  153.             self scrollActivity]! !
  154.  
  155.  
  156. !PaletteController methodsFor: 'model access'!
  157.  
  158. model: aModel 
  159.     super model: aModel.
  160.     self tools: self view tools! !
  161.  
  162.  
  163. !PaletteController methodsFor: 'tool accessing'!
  164.  
  165. currentTool
  166.     ^currentTool!
  167.  
  168. currentTool: aTool
  169.     currentTool _ aTool.
  170.     view installTool: (tools indexOf: aTool) "install controllers in canvas(es)"!
  171.  
  172. displayTools
  173.     marker displayAt: scrollBar inside topLeft.
  174.     self highlightTool: currentTool!
  175.  
  176. highlightTool: aTool
  177.     | anInteger origin | 
  178.     aTool isNil ifTrue: [^self].
  179.     anInteger _ (tools indexOf: aTool).
  180.     origin _ (self paletteTransformation applyTo: 0@anInteger) + 3.
  181.     Display reverse: (origin extent: -3+currentTool extent)!
  182.  
  183. selectTool
  184.     | aTool | 
  185.     aTool _ self toolLoop.
  186.     aTool isNil
  187.         ifTrue: [self highlightTool: currentTool]
  188.         ifFalse: [self currentTool: aTool]!
  189.  
  190. tools: aCollection
  191.     tools _ aCollection.
  192.     self currentTool: aCollection first.
  193.     self updateMarker!
  194.  
  195. updateMarker
  196.     | aTool border | 
  197.     aTool _ tools anElement.
  198.     marker _ Form extent: (aTool width + self toolBorder) @ (self toolHeight * tools size - self toolSeparation).
  199.     marker offset: self markerInset.
  200.     border _ 0@0 extent: aTool extent + self toolBorder.
  201.     tools do:
  202.         [:each |
  203.         each displayOn: marker at: border topLeft + self toolInset.
  204.         marker border: border width: 1.
  205.         border _ border translateBy: 0 @ (border height + self toolSeparation)].
  206.     scrollBar region: (marker boundingBox expandBy: self markerInset * 2)! !
  207.  
  208.  
  209. !PaletteController methodsFor: 'scrolling'!
  210.  
  211. scroll
  212.     "Check to see whether the user wishes to jump, scroll up, or scroll down."
  213.  
  214.     self scrollLoop! !
  215.  
  216.  
  217. !PaletteController methodsFor: 'private'!
  218.  
  219. markerInset
  220.     ^2@2!
  221.  
  222. paletteTransformation
  223.     ^WindowingTransformation
  224.         window: (0@1 extent: 1@tools size)
  225.         viewport: (scrollBar inside topLeft + 1 extent: currentTool width @ (self toolHeight * tools size))!
  226.  
  227. selectedTool
  228.     | index | 
  229.     index _ self toolIndexFor: sensor cursorPoint.
  230.     ^(index between: 1 and: tools size)
  231.         ifTrue: [tools at: index]
  232.         ifFalse: [nil]!
  233.  
  234. toolBorder
  235.     ^1!
  236.  
  237. toolHeight
  238.     ^currentTool height + self toolSeparation + self toolBorder!
  239.  
  240. toolIndexFor: aPoint
  241.     | newPoint | 
  242.     newPoint _ self paletteTransformation applyInverseTo: sensor cursorPoint.
  243.     (newPoint x between: 0 and: 1)
  244.         ifTrue: [^newPoint y truncated]
  245.         ifFalse: [^0]!
  246.  
  247. toolInset
  248.     ^0@0!
  249.  
  250. toolLoop
  251.     | aTool | 
  252.     self highlightTool: currentTool.
  253.     self highlightTool: (self selectedTool).
  254.     sensor
  255.         follow:
  256.             [:aPoint | aTool _ self selectedTool]
  257.         doing:
  258.             [:old :new | self highlightTool: old.
  259.             self highlightTool: new.
  260.             aTool _ self selectedTool].
  261.     ^aTool!
  262.  
  263. toolSeparation
  264.     ^2! !
  265.  
  266.  
  267. Controller subclass: #NoPaletteController
  268.     instanceVariableNames: ''
  269.     classVariableNames: ''
  270.     poolDictionaries: ''
  271.     category: 'Foible'!
  272. NoPaletteController comment:
  273. 'I can be used if there is no palette in the application, that is, the operations
  274. are handled via menus.  There must be one tool in the system, and that 
  275. tool is installed at startup.
  276. '!
  277.  
  278.  
  279. !NoPaletteController methodsFor: 'model access'!
  280.  
  281. model: aModel 
  282.     "Install the first tool as the initial tool."
  283.  
  284.     super model: aModel.
  285.     view installTool: 1! !
  286.  
  287.  
  288. DisplayObject subclass: #Foible
  289.     instanceVariableNames: 'forms boundingBoxCache '
  290.     classVariableNames: ''
  291.     poolDictionaries: ''
  292.     category: 'Foible'!
  293. Foible comment:
  294. 'I am the abstract class of all components of a visual program (links and 
  295. boxes).
  296.    
  297. Instance Variables:
  298.  
  299.     forms  <OrderedCollection>
  300.          collection of forms used for my visual representation.
  301.     boundingBoxCache <Rectangle>
  302.         stores my boundingBox, so it doesn''t have to be calculated each 
  303.         time.
  304.     '!
  305.  
  306.  
  307. !Foible methodsFor: 'comparing'!
  308.  
  309. containsPoint: aPoint 
  310.     "Return whether this point is in one of our forms"
  311.  
  312.     | aRect |
  313.     self forms do: 
  314.         [:each | 
  315.         aRect _ (Rectangle origin: each offset extent: each extent) translateBy: self offset.
  316.         (aRect containsPoint: aPoint)
  317.             ifTrue: [^OrderedCollection with: self]]. 
  318.     ^OrderedCollection new! !
  319.  
  320.  
  321. !Foible methodsFor: 'private'!
  322.  
  323. createForms
  324.     "This is the method that creates the form.  Subclasses implement this"
  325.  
  326.     self subclassResponsibility.        
  327.  
  328.         "This should be done in any implementation..."!
  329.  
  330. removeAllForms
  331.  
  332.     forms _ OrderedCollection new.
  333.     boundingBoxCache _ nil.    "Invalidates the boundingBox, of course"! !
  334.  
  335.  
  336. !Foible methodsFor: 'printing'!
  337.  
  338. prepareToStore
  339.     "Get the box ready to store- clear the form (waste)"
  340.  
  341.     self removeAllForms! !
  342.  
  343.  
  344. !Foible methodsFor: 'form access'!
  345.  
  346. baseForm
  347.  
  348.     ^self class baseForm!
  349.  
  350. forms
  351.  
  352.     (forms isEmpty) ifTrue: [self createForms].
  353.     ^forms! !
  354.  
  355.  
  356. !Foible methodsFor: 'accessing'!
  357.  
  358. boundingBox
  359.     "return boundingBox, compute if not already computed"
  360.  
  361.     boundingBoxCache notNil ifTrue: [^boundingBoxCache].
  362.     ^boundingBoxCache _ self computeBoundingBox!
  363.  
  364. computeBoundingBox
  365.     "Compute the smallest rectangle which will hold all the   
  366.     Forms in this Foible (with offset)"
  367.  
  368.     | aRectangle |
  369.     aRectangle _ self forms first relativeRectangle.
  370.     self forms do:
  371.         [:each | aRectangle _ aRectangle merge: each relativeRectangle].
  372.     ^aRectangle translateBy: self offset!
  373.  
  374. connectedTo: aFoibleBox
  375.     "Check to see if self is connected to some other FoibleBox"
  376.  
  377.     ^self subclassResponsibility!
  378.  
  379. hasPorts
  380.     ^false!
  381.  
  382. name
  383.  
  384.     ^self subclassResponsibility!
  385.  
  386. name: aValue
  387.  
  388.     ^self subclassResponsibility!
  389.  
  390. value
  391.     "This should be a good message for all subclasses..."
  392.  
  393.     self subclassResponsibility! !
  394.  
  395.  
  396. !Foible methodsFor: 'initialize'!
  397.  
  398. initialize
  399.  
  400.     forms _ OrderedCollection new.! !
  401.  
  402.  
  403. !Foible methodsFor: 'interface tests'!
  404.  
  405. acceptsDataLinks: aPoint 
  406.  
  407.     ^self subclassResponsibility!
  408.  
  409. canBeCopied
  410.  
  411.     ^true!
  412.  
  413. canBeDeleted
  414.  
  415.     ^true!
  416.  
  417. canMoveDependently
  418.     "Return whether I can be moved when I am in a Control box being moved"
  419.  
  420.     ^true!
  421.  
  422. canMoveIndependently
  423.     "Return whether I can move at the user's request"
  424.  
  425.     ^true!
  426.  
  427. givesDataLinks: aPoint
  428.  
  429.     ^self subclassResponsibility! !
  430.  
  431.  
  432. !Foible methodsFor: 'displaying-generic'!
  433.  
  434. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
  435.     "Simply blit the forms on aDisplayMedium, within clipRectangle "
  436.  
  437.     self forms do: [:form | form
  438.             displayOn: aDisplayMedium
  439.             at: aDisplayPoint + self offset
  440.             clippingBox: clipRectangle
  441.             rule: ruleInteger
  442.             mask: aForm]! !
  443.  
  444. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  445.  
  446. Foible class
  447.     instanceVariableNames: 'myForm '!
  448.  
  449.  
  450. !Foible class methodsFor: 'instance creation'!
  451.  
  452. new
  453.     "Create a new box"
  454.  
  455.     ^super new initialize! !
  456.  
  457.  
  458. !Foible class methodsFor: 'form access'!
  459.  
  460. baseForm
  461.     "Return the form for this class"
  462.  
  463.     myForm isNil ifTrue: [myForm _ self getIcon].
  464.     ^myForm deepCopy!
  465.  
  466. getIcon
  467.     "ask IconManager to get the form for my icon"
  468.  
  469.     ^ self getIcon: self name!
  470.  
  471. getIcon: iconName
  472.     "ask IconManager to get the icon with name aName"
  473.  
  474.     ^ IconManager getIcon: iconName fromDirectory: self iconDirectory! !
  475.  
  476.  
  477. !Foible class methodsFor: 'class initialization'!
  478.  
  479. initializeForms
  480.     " send this class method when the form for my class has been changed "
  481.     " <class name> initializeForms "
  482.  
  483.     myForm _ self getIcon! !
  484.  
  485.  
  486. Foible subclass: #FoibleBox
  487.     instanceVariableNames: 'name location owner '
  488.     classVariableNames: ''
  489.     poolDictionaries: ''
  490.     category: 'Foible'!
  491. FoibleBox comment:
  492. 'I am the abstract class of all boxes in a visual program.
  493.    
  494. Instance Variables:
  495.  
  496.     name <String>
  497.         uniquely identifies me in visual program.
  498.     location <Point>
  499.         my location on the screen (in View coordinates). this is really my 
  500.         offset. one use of location is to display my icon, since it does not 
  501.         know its location on the screen (its offset should be 0@0, or 
  502.         problems will arise).
  503.     owner <FoibleManager>
  504.         this is the manager that is in charge of me. it tells me when to 
  505.         display myself, and also tells me when to move or delete myself, or
  506.         my links.'!
  507.  
  508.  
  509. !FoibleBox methodsFor: 'accessing'!
  510.  
  511. box
  512.     " this method is needed when a Box does not have Ports (BoxWithDirectLinks),
  513.       because FoibleLink send messages to source (and destination) box, and the 
  514.       source and destination of a link to a BoxWithDiectLinks is the box "
  515.  
  516.     ^self!
  517.  
  518. connectedTo: aFoibleBox
  519.     "a FoibleBox is not directly connected to any other foibleBox"
  520.  
  521.     ^false!
  522.  
  523. extent
  524.  
  525.     ^self forms first extent!
  526.  
  527. inside: aManager    
  528.     " determine if I am inside aManager - 
  529.       i.e. I am managed by aManager or my manager is inside aManager "
  530.  
  531.     owner==aManager ifTrue: [^true].
  532.     (owner topLevel) ifTrue: [^false].
  533.     ^owner inside: aManager!
  534.  
  535. linkedTo: aFoibleBox
  536.  
  537.     self links do: [:each | (each linkedTo: aFoibleBox)
  538.             ifTrue: [^true]].
  539.     ^false!
  540.  
  541. links
  542.  
  543.     ^self subclassResponsibility!
  544.  
  545. name
  546.  
  547.     ^name!
  548.  
  549. name: aValue
  550.  
  551.     name _ aValue.!
  552.  
  553. offset
  554.  
  555.     ^location!
  556.  
  557. offset: aValue
  558.  
  559.     aValue x < 0 ifTrue: [^self error:'bad offset given'].
  560.     aValue y < 0 ifTrue: [^self error:'bad offset given'].
  561.      location _ aValue.
  562.     boundingBoxCache _ nil!
  563.  
  564. owner
  565.     "the manager that is responsable for me"
  566.  
  567.     ^owner!
  568.  
  569. setManager: aManager
  570.  
  571.     owner_aManager! !
  572.  
  573.  
  574. !FoibleBox methodsFor: 'adding'!
  575.  
  576. addLink: aBoxLink
  577.  
  578.     ^self subclassResponsibility! !
  579.  
  580.  
  581. !FoibleBox methodsFor: 'initialization'!
  582.  
  583. initializeAt: aPoint withName: aName
  584.  
  585.     ^self subclassResponsibility! !
  586.  
  587.  
  588. !FoibleBox methodsFor: 'removing'!
  589.  
  590. remove
  591.     " tell my manager to remove me from his list, and remove my links,
  592.       and if I am a complexBox (my manager is not nil), then tell my manager
  593.       to delete all Foibles that he owns "
  594.  
  595.     | aRect tmpRect |
  596.     aRect _ self owner removeBox: self.
  597.     aRect _ aRect merge: self removeLinks.
  598.     self manager notNil 
  599.         ifTrue: [tmpRect _ self manager removeAll.
  600.                 tmpRect notNil
  601.                     ifTrue: [aRect _ aRect merge: tmpRect]].
  602.     ^aRect!
  603.  
  604. removeLink: aLink
  605.  
  606.     ^self subclassResponsibility!
  607.  
  608. removeLinks
  609.     " tell all of my links to remove themselves "
  610.  
  611.     | aRect |
  612.     aRect _ self boundingBox.
  613.     self links do: [:each | aRect _ aRect merge: each remove].
  614.     ^aRect! !
  615.  
  616.  
  617. !FoibleBox methodsFor: 'form access'!
  618.  
  619. ghostForm
  620.     "Return a ghosted copy of the Form representing   
  621.     aFoibleBox without the offset. The cursor should always 
  622.     start at 0@0,  so we get a Form that does."
  623.  
  624.     | aForm |
  625.     aForm _ self baseForm offset: 0 @ 0.
  626.     ^aForm reverse: (Rectangle origin: 0 @ 0 extent: aForm extent)
  627.         mask: Form veryLightGray! !
  628.  
  629.  
  630. !FoibleBox methodsFor: 'finding'!
  631.  
  632. findAllIntersecting: aRect 
  633.     "Return an OrderedCollection of all the FoibleBoxes that   
  634.     intersect the area described by aRect. If aRect intersects  
  635.     this FoibleBox, return an OrderedCollection containing  
  636.     this box.  If not, return an empty OrderedCollection.   
  637.     aRect is the area of some FoibleBox."
  638.  
  639.     ((self boundingBox intersects: aRect)
  640.         and: [self boundingBox ~= aRect])
  641.         ifTrue: ["Don't return an OC containing this FoibleBox, if this 
  642.             FoibleBox's boundingBox boundingBox exactly 
  643.             equals aRect.  Every FoibleBox intersects itself, but 
  644.             we aren't interested in such FoibleBoxes."
  645.             ^OrderedCollection with: self]
  646.         ifFalse: [^OrderedCollection new]! !
  647.  
  648.  
  649. !FoibleBox methodsFor: 'moving'!
  650.  
  651. moveBy: aPoint topManager: topManager
  652.     " this moving method is called when I am inside of a complexBox. If I 
  653.       have any links that originate outside of topManager, then tell the link to
  654.       change its image. If I am a complexBox, then tell my manager to translate
  655.      all of the Foibles that it manages by aPoint "
  656.  
  657.     | aRect |
  658.     self offset: self offset+aPoint.
  659.     aRect _ self boundingBox.
  660.     self links do:
  661.         [:eachLink | (eachLink owner ~= self owner and: [ (eachLink isContainedIn: topManager) not])
  662.             ifTrue: [aRect _ aRect merge: (eachLink boxMoved: self by: aPoint)]].    
  663.      self manager notNil 
  664.         ifTrue: [aRect _ aRect merge: (self manager moveAllBy: aPoint topManager: topManager)].
  665.     ^aRect!
  666.  
  667. moveFoiblesBy: aPoint
  668.     "tell all of myLinks that I moved by aPoint. Return a Rectangle composed of
  669.      the boundingBoxes of my links (in both their new and old positions) and my 
  670.     boundingBox (so the return value is always nonNil). If I am a complexBox,
  671.     then tell my manager to move all of the Foibles that it manages by aPoint "
  672.  
  673.     | aRect |
  674.     aRect _ self boundingBox.
  675.     self links do: 
  676.         [:aLink | aRect _ aRect merge: (aLink boxMoved: self by: aPoint)].
  677.     self manager notNil
  678.         ifTrue: [aRect _ aRect merge: (self manager moveAllBy: aPoint)].
  679.     ^aRect! !
  680.  
  681.  
  682. !FoibleBox methodsFor: 'manager access'!
  683.  
  684. manager
  685.     "the receiver does not own a manager unless specifically set"
  686.  
  687.     ^nil! !
  688.  
  689.  
  690. !FoibleBox methodsFor: 'port access'!
  691.  
  692. findInputPort: aPoint 
  693.     "find and return an input port that can be linked to at aPoint"
  694.  
  695.     ^self subclassResponsibility!
  696.  
  697. findOutputPort: aPoint 
  698.     "find and return an output port that can be linked to at aPoint "
  699.  
  700.     ^self subclassResponsibility! !
  701.  
  702. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  703.  
  704. FoibleBox class
  705.     instanceVariableNames: ''!
  706.  
  707.  
  708. !FoibleBox class methodsFor: 'instance creation'!
  709.  
  710. offset: aPoint withName: aString
  711.     "create aType FoibleBox at aPoint"
  712.  
  713.     | foibleBox |
  714.     foibleBox _ super new. 
  715.     foibleBox initializeAt: aPoint withName: aString.
  716.     ^foibleBox! !
  717.  
  718.  
  719. !FoibleBox class methodsFor: 'form access'!
  720.  
  721. iconDirectory
  722.     "return the directory that contains the icons for my icon"
  723.  
  724.     self subclassResponsibility! !
  725.  
  726.  
  727. FoibleBox subclass: #BoxWithDirectLinks
  728.     instanceVariableNames: 'links '
  729.     classVariableNames: ''
  730.     poolDictionaries: ''
  731.     category: 'Foible'!
  732. BoxWithDirectLinks comment:
  733. 'I am the abstract class of boxes in a visual program that does not use Ports
  734. to connect links and send information. Links are connected directly to 
  735. instances of me, and my instances talk directly to the links when 
  736. information is passed through the system.
  737.    
  738. Instance Variables:
  739.  
  740.     links <OrderedCollection>
  741.         a collection of my links, used for both input and output. there is no 
  742.         restriction placed on the number of links allowed, so if a restriction 
  743.         is needed it must be implemented in a subclass of me.'!
  744.  
  745.  
  746. !BoxWithDirectLinks methodsFor: 'accessing'!
  747.  
  748. links
  749.     " use a copy in case links are being deleted "
  750.  
  751.     ^links copy! !
  752.  
  753.  
  754. !BoxWithDirectLinks methodsFor: 'adding'!
  755.  
  756. addLink: aBoxLink
  757.     links add: aBoxLink.! !
  758.  
  759.  
  760. !BoxWithDirectLinks methodsFor: 'removing'!
  761.  
  762. removeLink: aBoxLink
  763.     links remove: aBoxLink.! !
  764.  
  765.  
  766. !BoxWithDirectLinks methodsFor: 'initialization'!
  767.  
  768. initializeAt: aPoint withName: aName
  769.  
  770.     name isNil ifFalse: [^self error:'Cannot reinitialize a ',self class name].
  771.     name _ aName.
  772.     self offset: aPoint.
  773.     links _ OrderedCollection new.! !
  774.  
  775.  
  776. FoibleBox subclass: #BoxWithPorts
  777.     instanceVariableNames: 'inputPorts outputPort '
  778.     classVariableNames: ''
  779.     poolDictionaries: ''
  780.     category: 'Foible'!
  781. BoxWithPorts comment:
  782. 'I am the abstract class of boxes in a visual program that use Ports to 
  783. connect links, and send information. Links are connected directly to my 
  784. ports, and when information is passed through the system, links talk to my 
  785. ports, and my ports talk to me.
  786.  
  787. Instance Variables:
  788.  
  789.     inputPorts <OrderedCollection>
  790.         a collection of Ports, used for input, that links can connect to. only 
  791.         one link can connect to each Port, so the number of inputs that I 
  792.         have is limited to the number of Ports that I have in inputPorts.
  793.     outputPort <OrderedCollection>
  794.         a collection of one Port, used for output, that links can originate 
  795.         from. there is no limit to the number of links that can originate from
  796.         this Port, that is why there there is only one outputPort.'!
  797.  
  798.  
  799. !BoxWithPorts methodsFor: 'accessing'!
  800.  
  801. hasPorts
  802.     ^true!
  803.  
  804. links
  805.     | myLinks |
  806.     myLinks _ OrderedCollection new.
  807.     inputPorts notNil
  808.         ifTrue: [ inputPorts do: 
  809.                     [:each | each link notNil
  810.                                 ifTrue: [myLinks add: each link]]].
  811.     outputPort notNil
  812.         ifTrue: [outputPort do:
  813.                     [:each | each link notNil
  814.                                 ifTrue: [myLinks addAll: each link]]].
  815.     ^myLinks! !
  816.  
  817.  
  818. !BoxWithPorts methodsFor: 'adding'!
  819.  
  820. addLink: aBoxLink! !
  821.  
  822.  
  823. !BoxWithPorts methodsFor: 'removing'!
  824.  
  825. removeLink: aBoxLink! !
  826.  
  827.  
  828. !BoxWithPorts methodsFor: 'initialization'!
  829.  
  830. initializeAt: aPoint withName: aName
  831.  
  832.     name isNil ifFalse: [^self error:'Cannot reinitialize a ',self class name].
  833.     name _ aName.
  834.     self offset: aPoint!
  835.  
  836. initializePorts
  837.     "initialize the ports of the BoxPorts"
  838.     "it has the form 'self inputs: 2'. FoibleBoxes have only 1 OutPutPort, but it can have many links."
  839.  
  840.     self subclassResponsibility! !
  841.  
  842.  
  843. !BoxWithPorts methodsFor: 'port access'!
  844.  
  845. initInputPortsFromRectangles: rectangles 
  846.  
  847.     inputPorts _ rectangles collect: [:each | (InputPort new: each)
  848.                     box: self]!
  849.  
  850. initOutputPortsFromRectangles: rectangles 
  851.  
  852.     outputPort _ rectangles collect: [:each | (OutputPort new: each)
  853.                     box: self]!
  854.  
  855. inputs: numInputs 
  856.     "initializes a BoxWithPorts with the specified number of input    
  857.       ports and one output port (which can hold many links)."
  858.  
  859.     | rectangles newExtent newOrigin rectangle |
  860.     newExtent _ self extent x / 2 @ self extent y. "left half"
  861.     rectangles _ (Rectangle origin: 0 @ 0 extent: newExtent)
  862.                 partition: numInputs.
  863.     self initInputPortsFromRectangles: rectangles.
  864.     newOrigin _ newExtent x @ 0.
  865.     rectangle _ Rectangle origin: newOrigin extent: newExtent. "right half"
  866.     outputPort _ (OutputPort new: rectangle) box: self!
  867.  
  868. inputs: numInputs outputs: numOutputs 
  869.  
  870.     | newExtent newOrigin rectangles |
  871.     inputPorts _ OrderedCollection new.
  872.     outputPort _ OrderedCollection new.
  873.     (numInputs = 0 and: [numOutputs = 0])
  874.         ifTrue: [^nil].
  875.     numInputs = 0
  876.         ifTrue: 
  877.             [self outputs: numOutputs.
  878.             ^nil].
  879.     numOutputs = 0
  880.         ifTrue: 
  881.             [self inputs: numInputs.
  882.             ^nil].
  883.     newExtent _ self extent x / 2 @ self extent y.
  884.     rectangles _ (Rectangle origin: 0 @ 0 extent: newExtent)
  885.                 partition: numInputs.
  886.      self initInputPortsFromRectangles: rectangles.
  887.     newOrigin _ newExtent x @ 0.
  888.     rectangles _ (Rectangle origin: newOrigin extent: newExtent)
  889.                 partition: numOutputs.
  890.      self initOutputPortsFromRectangles: rectangles!
  891.  
  892. outputs: numOutputs 
  893.     "initializes a BoxWithPorts with the specified number of output 
  894.                 ports and zero input ports"
  895.  
  896.     | rectangles |
  897.     rectangles _ (Rectangle origin: 0 @ 0 extent: self extent)
  898.                 partition: numOutputs.
  899.     self initOutputPortsFromRectangles: rectangles! !
  900.  
  901.  
  902. Foible subclass: #FoibleLink
  903.     instanceVariableNames: 'source destination '
  904.     classVariableNames: ''
  905.     poolDictionaries: ''
  906.     category: 'Foible'!
  907. FoibleLink comment:
  908. 'I am the abstract class that represents links between boxes in a visual 
  909. program. I serve as a visual link between boxes, and I am used to pass 
  910. information through the system.
  911.    
  912. Instance Variables:
  913.  
  914.     source <OutputPort> or <FoibleBox>
  915.         the object that I am directly connected to, on the box that I 
  916.         originate from. source is an OutputPort when the box that I originate
  917.         from is a BoxWithPorts, and source is a FoibleBox when the box that 
  918.         I originate from is a BoxWithDirectLinks.
  919.     destination <InputPort> or <FoibleBox>
  920.         the object that I am directly connected to, on the box that I connect
  921.         to. destination is an InputPort when the box that I connect to is a 
  922.         BoxWithPorts, and destination is a FoibleBox when the box that I 
  923.         connect to is a BoxWithDirectLinks.'!
  924.  
  925.  
  926. !FoibleLink methodsFor: 'initialization'!
  927.  
  928. from: aSource to: aDest withPath: newPath 
  929.     "Initialize this FoibleLink linked from aSource to  
  930.     aDest, using the given newPath to make my form"
  931.  
  932.     source isNil ifFalse: [self error: 'cannot re-initialize a ' , self class name].
  933.     (aDest box linkedTo: aSource box)
  934.         ifTrue: 
  935.             [PopUpNotifier message: 'Circular link: ' , aSource name , '  is already connected to ' , aDest name.
  936.             ^nil].
  937.     source _ aSource.
  938.      source addLink: self.
  939.     destination _ aDest.
  940.     destination addLink: self.
  941.     self path: newPath! !
  942.  
  943.  
  944. !FoibleLink methodsFor: 'moving'!
  945.  
  946. boxMoved: aFoibleBox by: aPoint
  947.     " I need to change my form when one of my boxes moves "
  948.  
  949.     (self connectedTo: aFoibleBox)    
  950.         ifTrue: [^self remakeForm: aFoibleBox by:aPoint].!
  951.  
  952. boxMoved: aFoibleBox moveAllBy: aPoint
  953.  
  954.     (self connectedTo: aFoibleBox)    
  955.         ifTrue: [self moveBy: aPoint].!
  956.  
  957. moveBy: aPoint
  958.     " translate all of my forms by aPoint "
  959.  
  960.     | aRect |
  961.     aRect _ self boundingBox.
  962.     forms do: 
  963.         [:line | line beginPoint: line beginPoint+aPoint. 
  964.                 line endPoint: line endPoint+aPoint].
  965.      boundingBoxCache _ nil.
  966.     ^ aRect merge: self boundingBox! !
  967.  
  968.  
  969. !FoibleLink methodsFor: 'removing'!
  970.  
  971. remove
  972.     "tell my manager to remove me from his list, and tell my ports to remove me"
  973.  
  974.     destination removeLink: self.
  975.      source removeLink: self.
  976.     ^self owner removeLink: self! !
  977.  
  978.  
  979. !FoibleLink methodsFor: 'accessing'!
  980.  
  981. box
  982.  
  983.     ^source box!
  984.  
  985. boxName
  986.  
  987.     ^source box name!
  988.  
  989. connectedTo: aFoibleBox 
  990.  
  991.     ^destination box = aFoibleBox | (source box = aFoibleBox)!
  992.  
  993. defaultLineClass
  994.     "answer the type of line to use"
  995.  
  996.     ^FoibleLine!
  997.  
  998. formAtPoint: aPoint
  999.     "return the topmost form of mine, if any that contain aPoint"
  1000.  
  1001.     | theIndex | 
  1002.     theIndex_(self forms findFirst: [:each | each relativeRectangle containsPoint: aPoint]).
  1003.     theIndex=0 ifTrue:[^nil].
  1004.     ^self forms at: theIndex!
  1005.  
  1006. isContainedIn: aMgr
  1007.     "return true if I am managed by aMgr (FoibleManager)"
  1008.  
  1009.     ^(source box inside: aMgr) and: [destination box inside: aMgr]!
  1010.  
  1011. isFirstInPath: aLine
  1012.  
  1013.     ^aLine=self forms first!
  1014.  
  1015. isLastInPath: aLine
  1016.  
  1017.     ^aLine=self forms last!
  1018.  
  1019. lineAfter: aLine
  1020.     "Return the line that is after aLine in path"
  1021.  
  1022.     (self forms includes: aLine)
  1023.         ifTrue:[(self isLastInPath: aLine)
  1024.                     ifFalse:[^self forms after: aLine]].
  1025.     ^nil!
  1026.  
  1027. lineBefore: aLine
  1028.     "Return the line that is before aLine in path"
  1029.  
  1030.     (self forms includes: aLine)
  1031.         ifTrue:[(self isFirstInPath: aLine)
  1032.                     ifFalse:[^self forms before: aLine]].
  1033.     ^nil!
  1034.  
  1035. linkedTo: aFoibleBox
  1036.  
  1037.     ^destination box = aFoibleBox!
  1038.  
  1039. name
  1040.  
  1041.     ^(self class name,' from ',source name,' to ',destination name)!
  1042.  
  1043. offset
  1044.     ^0@0!
  1045.  
  1046. owner  
  1047.     ^source box owner!
  1048.  
  1049. path: aPath
  1050.     "Change the path of this link to aPath"
  1051.  
  1052.     self makeForm: aPath.!
  1053.  
  1054. source
  1055.     ^source!
  1056.  
  1057. toBox
  1058.  
  1059.     ^destination box!
  1060.  
  1061. value
  1062.  
  1063.     ^source value! !
  1064.  
  1065.  
  1066. !FoibleLink methodsFor: 'private'!
  1067.  
  1068. addLinesFor: aBox movedBy: aPoint
  1069.     "replace single line in path between boxes with three lines
  1070.         note: this should be called only if I have 1 line in the path "
  1071.  
  1072.     | newPath theLine oldBegin oldEnd newBegin newEnd loc2 loc3 aRect |
  1073.     newPath _ OrderedCollection new.
  1074.     theLine _ self forms last.    
  1075.     aRect _ theLine relativeRectangle.
  1076.     oldBegin _ theLine beginPoint.
  1077.     oldEnd _ theLine endPoint.
  1078.     (self source box = aBox)  "for firstLine horizontal"
  1079.         ifTrue:[newBegin_oldBegin+aPoint.
  1080.                 newEnd_oldEnd]
  1081.         ifFalse:[newEnd_oldEnd+aPoint.
  1082.                 newBegin_oldBegin].
  1083.     theLine horizontal
  1084.         ifTrue:[loc2_(newBegin x + newEnd x) abs // 2 @ newBegin y.
  1085.                 loc3_(newBegin x + newEnd x) abs // 2 @ newEnd y.]
  1086.         ifFalse:[loc2_ newBegin x @ ((newBegin y + newEnd y) abs // 2).
  1087.                 loc3_newEnd x @ ((newBegin y + newEnd y) abs // 2).].
  1088.     newPath     add: (self defaultLineClass from: newBegin to: loc2);
  1089.                 add: (self defaultLineClass from: loc2 to: loc3);
  1090.                 add: (self defaultLineClass from: loc3 to: newEnd).
  1091.     self replacePathFromLine: theLine toLine: theLine withLines: newPath.
  1092.     newPath do: [:each | aRect _ aRect merge: each relativeRectangle].
  1093.     ^ aRect!
  1094.  
  1095. addPattern: anInfiniteForm toForm: aForm 
  1096.     "Give this form the pattern from anInfiniteForm"
  1097.  
  1098.     anInfiniteForm
  1099.         displayOn: aForm
  1100.         at: aForm offset
  1101.         clippingBox: aForm boundingBox
  1102.         rule: Form over
  1103.         mask: nil!
  1104.  
  1105. createForms
  1106.     "if this method is called, then something's wrong, because my form
  1107.      should never be empty; it is created immediately"
  1108.  
  1109.     self error: 'forms is empty, and should not be'!
  1110.  
  1111. makeForm: newPath 
  1112.     " Create the forms necessary to represent this linkbox along path"
  1113.  
  1114.     self removeAllForms.
  1115.     newPath do: [:line | forms add: line.
  1116.                             line link: self.
  1117.                             line displayForm]!
  1118.  
  1119. remakeForm: aBox by: aPoint
  1120.     " fix my forms after aBox has moved "
  1121.  
  1122.     | aRect |    
  1123.     (self forms size) = 1
  1124.         ifTrue:[aRect _ self addLinesFor: aBox movedBy: aPoint]
  1125.         ifFalse:[aRect _ self stretchLinesFor: aBox movedBy: aPoint].
  1126.      boundingBoxCache _ nil.
  1127.     ^aRect!
  1128.  
  1129. replacePathFromLine: from toLine: to withLines: newLines
  1130.  
  1131.     | newPath |
  1132.     from=forms first
  1133.         ifTrue:[newPath_OrderedCollection new.]
  1134.         ifFalse:[newPath_forms copyFrom: (forms indexOf: (forms first)) to: (forms indexOf: (forms before: from)).].
  1135.     newPath addAll: newLines.
  1136.     to=forms last
  1137.         ifFalse:[newPath addAll: (forms copyFrom: (forms indexOf: (forms after: to)) to: (forms indexOf: (forms last))).].
  1138.     ^self path: newPath!
  1139.  
  1140. stretchLinesFor: aBox movedBy: aPoint
  1141.     "adjust first 2 (or last 2) lines in path due to aBox moving"
  1142.  
  1143.     | line1 line2 loc1 loc2 loc3 newLines aRect |
  1144.     newLines_OrderedCollection new.
  1145.     (self source box = aBox)  "link is coming out of box"
  1146.         ifTrue:[line1_self forms first.
  1147.                 line2_line1 next.
  1148.                 loc1_line1 beginPoint+aPoint.
  1149.                 loc3_line2 endPoint]
  1150.         ifFalse:[line2_self forms last.  "link is going into box"
  1151.                 line1_line2 prev.
  1152.                 loc3_line2 endPoint+aPoint.
  1153.                 loc1_line1 beginPoint].
  1154.     line1 horizontal
  1155.         ifTrue:[loc2_loc3 x@loc1 y]
  1156.         ifFalse:[loc2_loc1 x@loc3 y].
  1157.     " lines may change direction, so just replace them "
  1158.     newLines     add: (self defaultLineClass from: loc1 to: loc2);
  1159.                 add: (self defaultLineClass from: loc2 to: loc3).
  1160.     self replacePathFromLine: line1 toLine: line2 withLines: newLines.
  1161.     aRect _ line1 relativeRectangle merge: line2 relativeRectangle.
  1162.     newLines do: [:each | aRect _ aRect merge: each relativeRectangle].
  1163.     ^ aRect! !
  1164.  
  1165. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1166.  
  1167. FoibleLink class
  1168.     instanceVariableNames: 'east linkWidth north south west '!
  1169.  
  1170.  
  1171. !FoibleLink class methodsFor: 'instance creation'!
  1172.  
  1173. from: aSource to: aDest withPath: path
  1174.     "Create a new Link linked from fromPort to toPort,
  1175.         following path points to draw the link"
  1176.  
  1177.     | newLink |
  1178.     newLink _ super new.
  1179.     ^newLink from: aSource to: aDest withPath: path! !
  1180.  
  1181.  
  1182. !FoibleLink class methodsFor: 'class initialization'!
  1183.  
  1184. initializeForms
  1185.  
  1186.     myForm _ self getIcon.
  1187.     linkWidth _ myForm extent x.        "Width of link forms"
  1188.     north _ InfiniteForm with: myForm.
  1189.     east _ InfiniteForm with: (myForm rotateBy: 1).
  1190.     south _ InfiniteForm with: (myForm rotateBy: 2).
  1191.     west _ InfiniteForm with: (myForm rotateBy: 3)! !
  1192.  
  1193.  
  1194. !FoibleLink class methodsFor: 'form access'!
  1195.  
  1196. eastForm
  1197.     "Return the eastward infinite form for this class"
  1198.  
  1199.     east isNil ifTrue: [self initializeForms].
  1200.  
  1201.     ^east deepCopy!
  1202.  
  1203. iconDirectory
  1204.     "return the directory that contains the icons for the FlowKit"
  1205.  
  1206.     ^FoibleDirectory iconDirectory!
  1207.  
  1208. northForm
  1209.     "Return the northward infinite form for this class"
  1210.  
  1211.     north isNil ifTrue: [self initializeForms].
  1212.  
  1213.     ^north deepCopy!
  1214.  
  1215. southForm
  1216.     "Return the southward infinite form for this class"
  1217.  
  1218.     south isNil ifTrue: [self initializeForms].
  1219.  
  1220.     ^south deepCopy!
  1221.  
  1222. westForm
  1223.     "Return the westward infinite form for this class"
  1224.  
  1225.     west isNil ifTrue: [self initializeForms].
  1226.  
  1227.     ^west deepCopy!
  1228.  
  1229. width
  1230.     "Return the width of this type of link"
  1231.  
  1232.     linkWidth isNil ifTrue: [self initializeForms].
  1233.  
  1234.     ^linkWidth! !
  1235.  
  1236.  
  1237. DisplayObject subclass: #FoibleManager
  1238.     instanceVariableNames: 'boxes links ourCursor nameNum myBox program '
  1239.     classVariableNames: 'MinRect '
  1240.     poolDictionaries: ''
  1241.     category: 'Foible'!
  1242. FoibleManager comment:
  1243. 'I manage a collection of Foibles.  Visually, I manage the 2 1/2 dimensional
  1244. representation of my Foibles, and the links between my Foibles.  I also can
  1245. be asked for any or all of my Foibles that meet a certain criterea.
  1246.  
  1247. Instance Variables:
  1248.  
  1249.     boxes <OrderedCollection>
  1250.         a collection of the FoibleBoxes that I manage.
  1251.     links <OrderedCollection>
  1252.         a collection of the FoibleLinks that I manage.
  1253.     ourCursor <Cursor>
  1254.         stores the cursor for the currently active Tool. it is initialized to a 
  1255.         normal cursor.  only top-level managers seem to need this variable.
  1256.     nameNum <Integer>
  1257.         used to uniquely name each new box that is created.
  1258.     myBox <FoibleBox> or nil
  1259.         nonNil only when I am the manager of a ComplexBox. if myBox is 
  1260.         nonNil, then I am managing the Foibles inside of myBox, otherwise I
  1261.         am managing the Foibles in a canvas (I am a top-level manager).
  1262.     program <FoibleProgram> or nil
  1263.         nonNil only when I am a top-level manager. program is the 
  1264.         top-level model of an executing application
  1265.  
  1266. NOTE: if multiple-inheritance get working, then there probably should be 
  1267. two subclasses of FoibleManager, with the instance variables distributed 
  1268. like this:
  1269.  
  1270. Foible (boxes, links, nameNum)
  1271. TopLevelManager (ourCursor, program)
  1272. ComplexBoxManager (myBox)'!
  1273.  
  1274.  
  1275. !FoibleManager methodsFor: 'accessing'!
  1276.  
  1277. cursor
  1278.  
  1279.     ^ourCursor!
  1280.  
  1281. cursor: aCursor
  1282.     ourCursor _ aCursor.!
  1283.  
  1284. inside: aManager
  1285.     ^myBox inside: aManager!
  1286.  
  1287. isEmpty
  1288.  
  1289.     ^((boxes size) = 0)!
  1290.  
  1291. isManagerOf: aFoible 
  1292.     "test to see if aFoible is under management of the receiver "
  1293.  
  1294.     ^self = aFoible owner!
  1295.  
  1296. myBox
  1297.  
  1298.     ^myBox!
  1299.  
  1300. nameNum
  1301.  
  1302.     ^nameNum!
  1303.  
  1304. nameNum: aNumber
  1305.     "Set the nameNum, complain if not nil"
  1306.  
  1307.     nameNum isNil
  1308.         ifTrue: [nameNum _ aNumber]
  1309.         ifFalse: [self error: 'Cannot change nameNum'].!
  1310.  
  1311. owner
  1312.  
  1313.     ^myBox owner!
  1314.  
  1315. program
  1316.     ^program!
  1317.  
  1318. program: aProgram
  1319.     program _ aProgram!
  1320.  
  1321. topLevel
  1322.     " returns true if I am a top level manager (the manager of a canvas) "
  1323.  
  1324.     ^program notNil! !
  1325.  
  1326.  
  1327. !FoibleManager methodsFor: 'moving'!
  1328.  
  1329. moveAllBy: aPoint 
  1330.     " translate of my foibles"
  1331.  
  1332.     ^self moveAllBy: aPoint topManager: self!
  1333.  
  1334. moveAllBy: aPoint topManager: topManager
  1335.     " translate of my foibles, the highest level box moved is managed by topManager"
  1336.  
  1337.     | movableBoxes aRect |
  1338.     aRect _ myBox boundingBox.
  1339.     movableBoxes _ boxes select: [:each | each canMoveDependently].
  1340.     movableBoxes do: 
  1341.         [:each | aRect _ aRect merge: (self moveBox: each By: aPoint topManager: topManager)].
  1342.     links do: 
  1343.         [:each | 
  1344.             (each isContainedIn: topManager)
  1345.                 ifTrue: [ "this link is totally inside me, so just translate it"
  1346.                         aRect _ aRect merge: (each moveBy: aPoint)]
  1347.                 ifFalse: [ "this link originates in me, but ends up outside of me"
  1348.                         aRect _ aRect merge: (each boxMoved: each box by: aPoint)]].
  1349.     ^aRect!
  1350.  
  1351. moveBox: aBox By: aPoint topManager: topManager
  1352.     " translate aBox, the highest level box moved is managed by topManager "
  1353.  
  1354.     | aRect |
  1355.     aRect _ self removeBox: aBox.
  1356.     aRect _ aRect merge: (aBox moveBy: aPoint topManager: topManager).
  1357.     boxes addLast: aBox.
  1358.     ^aRect!
  1359.  
  1360. moveBox: aBox byBlock: aBlock
  1361.     "Move aBox according to aBlock, relocating aBox to the back of the list,    to 
  1362.      retain 2 1/2 D.  If I do not currently manage aBox, then remove aBox (and
  1363.     all of its links) from it current manager, and add aBox to my list of boxes"
  1364.  
  1365.     | bigBox oldOffset |
  1366.     (self isManagerOf: aBox)
  1367.         ifTrue: [bigBox _ self removeBox: aBox]
  1368.         ifFalse: [bigBox _ aBox owner removeBox: aBox.
  1369.                   bigBox _ bigBox merge: aBox removeLinks].
  1370.     oldOffset _ aBox offset.
  1371.     aBlock value: aBox.
  1372.     bigBox _ bigBox merge: (aBox moveFoiblesBy: ((aBox offset) - oldOffset)).
  1373.     aBox setManager: self.
  1374.     boxes addLast: aBox.
  1375.     ^bigBox merge: aBox boundingBox! !
  1376.  
  1377.  
  1378. !FoibleManager methodsFor: 'adding'!
  1379.  
  1380. addBox: boxBlock
  1381.     "add a new FoibleBox created with boxBlock with the latest name"
  1382.  
  1383.     | foibleBox name stream |
  1384.     name _ 'Box','#############'.
  1385.     stream _ WriteStream on: name from: 4 to: (name size).
  1386.     nameNum printOn: stream.
  1387.     name _ name copyUpTo: $#.
  1388.     nameNum _ nameNum + 1. 
  1389.     foibleBox _ boxBlock value: name. 
  1390.     foibleBox hasPorts
  1391.         ifTrue: [foibleBox initializePorts]. 
  1392.     boxes add: foibleBox.
  1393.     ^foibleBox boundingBox!
  1394.  
  1395. addLink: newLink
  1396.  
  1397.     links add: newLink.
  1398.     ^newLink boundingBox!
  1399.  
  1400. addLink: aLinkClass from: fromPort to: toPort withPath: path 
  1401.  
  1402.     | aLink |
  1403.     aLink _ aLinkClass
  1404.                 from: fromPort
  1405.                 to: toPort
  1406.                 withPath: path.
  1407.     aLink isNil ifTrue: [^nil].
  1408.     ^self addLink: aLink! !
  1409.  
  1410.  
  1411. !FoibleManager methodsFor: 'removing'!
  1412.  
  1413. remove: aFoible 
  1414.     "tell aFoible to remove itself"
  1415.  
  1416.     ^ aFoible remove!
  1417.  
  1418. removeAll
  1419.     "tell all of my boxes to remove themselves"
  1420.  
  1421.     | myBoxes aRect tmpRect |
  1422.     myBoxes _ boxes shallowCopy.
  1423.     myBoxes do: 
  1424.         [:each |     tmpRect _ each remove.
  1425.                     aRect isNil 
  1426.                         ifTrue: [aRect _ tmpRect]
  1427.                         ifFalse: [aRect _ aRect merge: tmpRect]].
  1428.     ^aRect!
  1429.  
  1430. removeBox: aFoibleBox 
  1431.  
  1432.     boxes remove: aFoibleBox.
  1433.     ^ aFoibleBox boundingBox!
  1434.  
  1435. removeLink: aFoibleLink 
  1436.  
  1437.     links remove: aFoibleLink.
  1438.     ^ aFoibleLink boundingBox! !
  1439.  
  1440.  
  1441. !FoibleManager methodsFor: 'initialize'!
  1442.  
  1443. initialize
  1444.     "initialize this new top-level manager"
  1445.  
  1446.     boxes _ OrderedCollection new.
  1447.     links _ OrderedCollection new.
  1448.     ourCursor _ Cursor normal.
  1449.     nameNum _ 1!
  1450.  
  1451. initializeWithBox: aBox
  1452.     "initialize this new complexBox manager with aBox as my matching box"
  1453.     
  1454.     boxes _ OrderedCollection new.
  1455.     links _ OrderedCollection new.
  1456.     ourCursor _ Cursor normal.
  1457.     nameNum _ 1.
  1458.     myBox _ aBox! !
  1459.  
  1460.  
  1461. !FoibleManager methodsFor: 'printing'!
  1462.  
  1463. prepareToStore
  1464.     "get the box ready to store -  get rid of
  1465.         recreateable viewForm, and tell boxes to kill their forms"
  1466.  
  1467.         "First, calculate next value based on present value"
  1468.     boxes do: [ :each | each prepareToStore].
  1469.     links do: [ :each | each prepareToStore].! !
  1470.  
  1471.  
  1472. !FoibleManager methodsFor: 'comparing'!
  1473.  
  1474. containsPoint: aPoint 
  1475.     "Return an Ordered Collection of the boxes that contain aPoint"
  1476.  
  1477.     | anOrderedCollection |
  1478.     anOrderedCollection _ OrderedCollection new.
  1479.     links do: [:each |  anOrderedCollection addAll: (each containsPoint: aPoint)].
  1480.     boxes do: [:each | anOrderedCollection addAll: (each containsPoint: aPoint)].
  1481. "    myBox notNil
  1482.         ifTrue: [(myBox containsPoint: aPoint)
  1483.             ifTrue: [anOrderedCollection add: myBox]]."
  1484.     ^anOrderedCollection! !
  1485.  
  1486.  
  1487. !FoibleManager methodsFor: 'displaying-generic'!
  1488.  
  1489. computeBoundingBox
  1490.     "Compute the smallest rectangle which will hold all the Foibles in the 
  1491.     receiver, or the minimum rectangle (as defined in the class variable 
  1492.     MinRect), whichever is larger"
  1493.  
  1494.     | aRectangle |  
  1495.     boxes size < 1 ifTrue: [^MinRect "Rectangle origin: 0@0 corner: 0@0"].
  1496.     aRectangle _ boxes first boundingBox.
  1497.     boxes do:
  1498.         [:each | aRectangle _ aRectangle merge: each boundingBox].
  1499.     links do:
  1500.         [:each | aRectangle _ aRectangle merge: each boundingBox].
  1501.     ^aRectangle!
  1502.  
  1503. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
  1504.     "display all foibles intersecting clipRectangle on aDisplayMedium"
  1505.  
  1506.     boxes do: [:each | (each boundingBox intersects: (clipRectangle translateBy: aDisplayPoint negated))
  1507.             ifTrue: [each
  1508.                     displayOn: aDisplayMedium
  1509.                     at: aDisplayPoint
  1510.                     clippingBox: clipRectangle
  1511.                     rule: ruleInteger
  1512.                     mask: aForm].
  1513.             each manager notNil
  1514.                 ifTrue: [each manager
  1515.                         displayOn: aDisplayMedium
  1516.                         at: aDisplayPoint
  1517.                         clippingBox: clipRectangle
  1518.                         rule: ruleInteger
  1519.                         mask: aForm]].
  1520.     links do: [:each | (each boundingBox intersects: (clipRectangle translateBy: aDisplayPoint negated))
  1521.             ifTrue: [each
  1522.                     displayOn: aDisplayMedium
  1523.                     at: aDisplayPoint
  1524.                     clippingBox: clipRectangle
  1525.                     rule: ruleInteger
  1526.                     mask: aForm]].! !
  1527.  
  1528.  
  1529. !FoibleManager methodsFor: 'finding'!
  1530.  
  1531. find: aPoint 
  1532.     "return the Foible that the cursor is on, if any"
  1533.     
  1534.     | aRect found |
  1535.     links
  1536.         reverseDo:             "Reverse for 2 1/2 D action"
  1537.             [:each | 
  1538.             found _ each containsPoint: aPoint.
  1539.             found isEmpty not ifTrue: [^found first]].
  1540.     boxes
  1541.         reverseDo:             "Reverse for 2 1/2 D action"
  1542.             [:each | 
  1543.             found _ each containsPoint: aPoint.
  1544.             found isEmpty not ifTrue: [^found first]].
  1545.     ^nil!
  1546.  
  1547. find: aPoint suchThat: aBlock 
  1548.     "return the Foible that the cursor is on, if any, 
  1549.     that evaluates aBlock as true"
  1550.  
  1551.     | anOrderedCollection |
  1552.     anOrderedCollection _ self containsPoint: aPoint.
  1553.     anOrderedCollection reverseDo: [:each | (aBlock value: each)
  1554.             ifTrue: [^each]].
  1555.      ^nil!
  1556.  
  1557. find: aPoint suchThatTwo: aBlock 
  1558.     "return the Foible that the cursor is on, if any, 
  1559.     that evaluates aBlock as true"
  1560.  
  1561.     | anOrderedCollection |
  1562.     anOrderedCollection _ self containsPoint: aPoint.
  1563.     anOrderedCollection reverseDo: [:each | (aBlock value: each value: aPoint)
  1564.             ifTrue: [^each]].
  1565.      ^nil!
  1566.  
  1567. findAllIntersecting: aRect 
  1568.     "Return an OrderedCollection of all the FoibleBoxes that   
  1569.     intersect the area described by aRect.  This   
  1570.     OrderedCollection may be empty, have one element, or   
  1571.     have more than one element.  It will never contain any   
  1572.     FoibleLinks. aRect is the area of some FoibleBox."
  1573.  
  1574.     | result |
  1575.     result _ OrderedCollection new.
  1576.     boxes do: [:aFoible | 
  1577.         (aFoible isKindOf: FoibleBox)
  1578.             ifTrue: [result addAll: (aFoible findAllIntersecting: aRect)]].
  1579.     ^result!
  1580.  
  1581. findAllLinksSuchThat: aBlock
  1582.     "Return an OrderedCollection of all the links (there may be more than one) that evaluate aBlock as true."
  1583.     | result |
  1584.     
  1585.     result _ OrderedCollection new.
  1586.     links
  1587.         reverseDo:  "Reverse for 2 1/2 D action"
  1588.             [:each | (aBlock value: each)
  1589.                     ifTrue: [result add: each]].
  1590.     ^result!
  1591.  
  1592. findAllSuchThat: aBlock
  1593.     "Return an OrderedCollection of all the Foibles (there may be more than one) that evaluate aBlock as true."
  1594.     | result |
  1595.     
  1596.     result _ OrderedCollection new.
  1597.     links
  1598.         reverseDo:  "Reverse for 2 1/2 D action"
  1599.             [:each | (aBlock value: each)
  1600.                     ifTrue: [result add: each]].    
  1601.     
  1602.     boxes    reverseDo:  "Reverse for 2 1/2 D action"
  1603.             [:each | (aBlock value: each)
  1604.                     ifTrue: [result add: each]].
  1605.     ^result!
  1606.  
  1607. findName: aString
  1608.     "Return Foible with name aString"
  1609.  
  1610.     ^self findSuchThat: [:each | (each name sameAs: aString)]!
  1611.  
  1612. findSuchThat: aBlock
  1613.     "return the Foible that evaluates aBlock as true"
  1614.     
  1615.     links
  1616.         reverseDo:  "Reverse for 2 1/2 D action"
  1617.             [:each | (aBlock value: each)
  1618.                     ifTrue: [^each]].    
  1619.     boxes
  1620.         reverseDo:  "Reverse for 2 1/2 D action"
  1621.             [:each | (aBlock value: each)
  1622.                     ifTrue: [^each]].
  1623.     ^nil! !
  1624.  
  1625. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1626.  
  1627. FoibleManager class
  1628.     instanceVariableNames: ''!
  1629.  
  1630.  
  1631. !FoibleManager class methodsFor: 'instance creation'!
  1632.  
  1633. new
  1634.     "create a new instance with cursor and type initialized"
  1635.  
  1636.     | aFoibleManager |
  1637.     aFoibleManager _ super new.
  1638.     aFoibleManager initialize.
  1639.     ^aFoibleManager!
  1640.  
  1641. newWithBox: aBox
  1642.     "create a new instance with cursor and type initialized and aBox
  1643.      as my matching box - added by Bill 10/25"
  1644.  
  1645.     | aFoibleManager |
  1646.     aFoibleManager _ super new.
  1647.     aFoibleManager initializeWithBox: aBox.
  1648.     ^aFoibleManager! !
  1649.  
  1650.  
  1651. !FoibleManager class methodsFor: 'class initialization'!
  1652.  
  1653. initialize
  1654.     "FoibleManager initialize"
  1655.  
  1656.     MinRect _ Rectangle origin: (0@0) extent: (150@150).! !
  1657.  
  1658.  
  1659. FoibleManager initialize!
  1660.  
  1661.  
  1662. Line subclass: #FoibleLine
  1663.     instanceVariableNames: 'link '
  1664.     classVariableNames: 'DrawingForm '
  1665.     poolDictionaries: ''
  1666.     category: 'Foible'!
  1667. FoibleLine comment:
  1668. 'I am the form that a FoibleLink''s form consists of.  I can display myself as a
  1669. line, which is used when my link is being created or edited, and I can 
  1670. display myself as a form, which is used when my FoibeLink wants to 
  1671. display its form.
  1672.  
  1673. I am an abstract class, but requests for new FoibleLines are sent to my 
  1674. class method from: to:.  There are 4 concrete subclasses of me: NorthLine,
  1675. SouthLine, EastLine, and WestLine, and in my class creation method I 
  1676. determine which of my subclasses to create.
  1677.    
  1678. Instance Variables:
  1679.  
  1680.     link <FoibleLink>
  1681.         the FoibleLink whose form I am a part of.
  1682.  
  1683. Class Variable:
  1684.  
  1685.     drawingForm <Form>
  1686.         the Form used to create my line representation.'!
  1687.  
  1688.  
  1689. !FoibleLine methodsFor: 'form access'!
  1690.  
  1691. formFor: aLink 
  1692.     "return the form representing the receiver's image"
  1693.  
  1694.     self subclassResponsibility! !
  1695.  
  1696.  
  1697. !FoibleLine methodsFor: 'initialize'!
  1698.  
  1699. from: sourcePoint to: destPoint withForm: aForm 
  1700.  
  1701.     self beginPoint: sourcePoint.
  1702.     self endPoint: destPoint.
  1703.     self form: aForm! !
  1704.  
  1705.  
  1706. !FoibleLine methodsFor: 'displaying'!
  1707.  
  1708. displayForm
  1709.     ^self formFor: self link!
  1710.  
  1711. displayLineOn: aDisplayMedium clippingBox: clipRect rule: anInteger mask: aForm
  1712.     " display myself as a Line "
  1713.  
  1714.     collectionOfPoints size < 2 ifTrue: [self error: 'a line must have two points'].
  1715.     aDisplayMedium
  1716.         drawLine: self form
  1717.         from: self beginPoint + clipRect origin
  1718.         to: self endPoint + clipRect origin
  1719.         clippingBox: clipRect
  1720.         rule: anInteger
  1721.         mask: aForm!
  1722.  
  1723. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm
  1724.     " display myself as a Link" 
  1725.  
  1726.  aDisplayMedium copyBits: self boundingBox
  1727.         from: (self formFor: self link)
  1728.         at: aDisplayPoint + self offset
  1729.         clippingBox: clipRectangle
  1730.         rule: ruleInteger
  1731.         mask: aForm!
  1732.  
  1733. eraseFormInClipBox: aClipBox
  1734.  
  1735.     self displayOn: Display 
  1736.         at: aClipBox origin
  1737.         clippingBox: (self relativeRectangle moveBy: aClipBox origin)
  1738.         rule: Form erase "reverse" 
  1739.         mask: nil.        "display opposite of whats on screen"!
  1740.  
  1741. formToLineInClippingBox: aClippingBox 
  1742.     "turn form white, and draw the line on the screen"
  1743.  
  1744.     self eraseFormInClipBox: aClippingBox.
  1745.     self xorInClippingBox: aClippingBox!
  1746.  
  1747. xorInClippingBox: aClippingBox
  1748.  
  1749.     self displayLineOn: Display
  1750.         clippingBox: aClippingBox
  1751.         rule: Form reverse 
  1752.         mask: nil.        "display opposite of whats on screen"! !
  1753.  
  1754.  
  1755. !FoibleLine methodsFor: 'accessing'!
  1756.  
  1757. extent
  1758.     ^(self formFor: self link) extent!
  1759.  
  1760. horizontal
  1761.     self subclassResponsibility!
  1762.  
  1763. link
  1764.     ^link!
  1765.  
  1766. link: aLink
  1767.     link_aLink!
  1768.  
  1769. next
  1770.     ^self link lineAfter: self!
  1771.  
  1772. offset
  1773.  
  1774.     ^(self formFor: self link) offset!
  1775.  
  1776. prev
  1777.     ^self link lineBefore: self!
  1778.  
  1779. relativeRectangle
  1780.     ^(self formFor: self link) relativeRectangle!
  1781.  
  1782. vertical
  1783.     self subclassResponsibility! !
  1784.  
  1785.  
  1786. !FoibleLine methodsFor: 'display box access'!
  1787.  
  1788. computeBoundingBox
  1789.  
  1790.     ^(self formFor: self link) computeBoundingBox! !
  1791.  
  1792. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1793.  
  1794. FoibleLine class
  1795.     instanceVariableNames: ''!
  1796.  
  1797.  
  1798. !FoibleLine class methodsFor: 'instance creation'!
  1799.  
  1800. from: source to: dest 
  1801.     "create a new FoibleLine, decide whether it points North, 
  1802.     South, East, or West, using DrawForm"
  1803.  
  1804.     source x = dest x
  1805.         ifTrue: [source y < dest y
  1806.                 ifTrue: [^SouthLine
  1807.                         from: source
  1808.                         to: dest
  1809.                         withForm: DrawingForm]
  1810.                 ifFalse: [^NorthLine
  1811.                         from: source
  1812.                         to: dest
  1813.                         withForm: DrawingForm]]
  1814.         ifFalse: 
  1815.             [source y = dest y ifFalse: [self error: 'must be right angles'].
  1816.             source x < dest x
  1817.                 ifTrue: [^EastLine
  1818.                         from: source
  1819.                         to: dest
  1820.                         withForm: DrawingForm]
  1821.                 ifFalse: [^WestLine
  1822.                         from: source
  1823.                         to: dest
  1824.                         withForm: DrawingForm]]!
  1825.  
  1826. from: source to: dest withForm: aForm 
  1827.     "create a new FoibleLine, decide whether it points North, 
  1828.     South, East, or West"
  1829.  
  1830.     source x = dest x
  1831.         ifTrue: [source y < dest y
  1832.                 ifTrue: [^SouthLine
  1833.                         from: source
  1834.                         to: dest
  1835.                         withForm: aForm]
  1836.                 ifFalse: [^NorthLine
  1837.                         from: source
  1838.                         to: dest
  1839.                         withForm: aForm]]
  1840.         ifFalse: 
  1841.             [source y = dest y ifFalse: [self error: 'must be right angles'].
  1842.             source x < dest x
  1843.                 ifTrue: [^EastLine
  1844.                         from: source
  1845.                         to: dest
  1846.                         withForm: aForm]
  1847.                 ifFalse: [^WestLine
  1848.                         from: source
  1849.                         to: dest
  1850.                         withForm: aForm]]! !
  1851.  
  1852.  
  1853. !FoibleLine class methodsFor: 'class initialization'!
  1854.  
  1855. initialize
  1856.     "FoibleLine initialize"
  1857.  
  1858.     DrawingForm _ Form extent: 1@1.
  1859.     DrawingForm black.! !
  1860.  
  1861.  
  1862. FoibleLine initialize!
  1863.  
  1864.  
  1865. FoibleLine subclass: #EastLine
  1866.     instanceVariableNames: ''
  1867.     classVariableNames: ''
  1868.     poolDictionaries: ''
  1869.     category: 'Foible'!
  1870.  
  1871.  
  1872. !EastLine methodsFor: 'form access'!
  1873.  
  1874. formFor: aLink 
  1875.     "return the form representing the receiver's image"
  1876.  
  1877.     | aForm compensate |
  1878.     compensate _ aLink class width // 2.
  1879.     aForm _ Form extent: (self endPoint x - self beginPoint x) asInteger @ aLink class width.
  1880.     aLink class eastForm
  1881.         displayOn: aForm
  1882.         at: aForm offset
  1883.         clippingBox: aForm boundingBox
  1884.         rule: Form over
  1885.         mask: nil.
  1886.     aForm offset: self beginPoint x @ (self beginPoint y - compensate).
  1887.     ^aForm! !
  1888.  
  1889.  
  1890. !EastLine methodsFor: 'testing'!
  1891.  
  1892. horizontal
  1893.  ^true!
  1894.  
  1895. vertical
  1896.  ^false! !
  1897.  
  1898.  
  1899. !EastLine methodsFor: 'box crossing'!
  1900.  
  1901. crossesBox: aDataFlowBox 
  1902.     "Return true if this EastLine crosses aDataFlowBox,  
  1903.     false if not.  'Crosses' means 'stretches across the entire  
  1904.     height or width of aDataFlowBox'."
  1905.  
  1906.     | startPoint endPoint box |
  1907.     startPoint _ collectionOfPoints first.
  1908.     endPoint _ collectionOfPoints second.
  1909.     box _ aDataFlowBox boundingBox.
  1910.     ^startPoint y > box top and: [startPoint y < box bottom and: [startPoint x < box left and: [endPoint x > box right]]]! !
  1911.  
  1912. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1913.  
  1914. EastLine class
  1915.     instanceVariableNames: ''!
  1916.  
  1917.  
  1918. !EastLine class methodsFor: 'instance creation'!
  1919.  
  1920. from: sourcePoint to: destPoint withForm: aForm 
  1921.     "create an instance of EastLine and initialize it"
  1922.  
  1923.     | anEastLine |
  1924.     sourcePoint x > destPoint x
  1925.         ifTrue: [self error: 'line created with incorrect points'].
  1926.     anEastLine _ super new.
  1927.     anEastLine
  1928.         from: sourcePoint
  1929.         to: destPoint
  1930.         withForm: aForm.
  1931.      ^anEastLine! !
  1932.  
  1933.  
  1934. FoibleLine subclass: #NorthLine
  1935.     instanceVariableNames: ''
  1936.     classVariableNames: ''
  1937.     poolDictionaries: ''
  1938.     category: 'Foible'!
  1939.  
  1940.  
  1941. !NorthLine methodsFor: 'form access'!
  1942.  
  1943. formFor: aLink 
  1944.     "return the form representing the receiver's image"
  1945.  
  1946.     | aForm compensate |
  1947.     compensate _ aLink class width // 2.
  1948.     aForm _ Form extent: aLink class width @ (self beginPoint y - self endPoint y) asInteger.
  1949.     aLink class northForm
  1950.         displayOn: aForm
  1951.         at: aForm offset
  1952.         clippingBox: aForm boundingBox
  1953.         rule: Form over
  1954.         mask: nil.
  1955.     aForm offset: self endPoint x - compensate @ self endPoint y.
  1956.     ^aForm! !
  1957.  
  1958.  
  1959. !NorthLine methodsFor: 'testing'!
  1960.  
  1961. horizontal
  1962.  ^false!
  1963.  
  1964. vertical
  1965.  ^true! !
  1966.  
  1967.  
  1968. !NorthLine methodsFor: 'box crossing'!
  1969.  
  1970. crossesBox: aDataFlowBox 
  1971.     "Return true if this NorthLine crosses aDataFlowBox,   
  1972.     false if not.  'Crosses' means 'stretches across the entire   
  1973.     height or width of aDataFlowBox'."
  1974.  
  1975.     | startPoint endPoint box |
  1976.     startPoint _ collectionOfPoints first.
  1977.     endPoint _ collectionOfPoints second.
  1978.     box _ aDataFlowBox boundingBox.
  1979.     ^startPoint x > box left and: [startPoint x < box right and: [startPoint y > box bottom and: [endPoint y < box top]]]! !
  1980.  
  1981. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1982.  
  1983. NorthLine class
  1984.     instanceVariableNames: ''!
  1985.  
  1986.  
  1987. !NorthLine class methodsFor: 'instance creation'!
  1988.  
  1989. from: sourcePoint to: destPoint withForm: aForm 
  1990.     "create an instance of NorthLine and initialize it"
  1991.  
  1992.     | aNorthLine |
  1993.     sourcePoint y < destPoint y
  1994.         ifTrue: [self error: 'line created with incorrect points'].
  1995.     aNorthLine _ super new.
  1996.     aNorthLine
  1997.         from: sourcePoint
  1998.         to: destPoint
  1999.         withForm: aForm.
  2000.      ^aNorthLine! !
  2001.  
  2002.  
  2003. FoibleLine subclass: #SouthLine
  2004.     instanceVariableNames: ''
  2005.     classVariableNames: ''
  2006.     poolDictionaries: ''
  2007.     category: 'Foible'!
  2008.  
  2009.  
  2010. !SouthLine methodsFor: 'form access'!
  2011.  
  2012. formFor: aLink 
  2013.     "return the form representing the receiver's image"
  2014.  
  2015.     | aForm compensate |
  2016.     compensate _ aLink class width // 2.
  2017.     aForm _ Form extent: aLink class width @ (self endPoint y - self beginPoint y) asInteger.
  2018.     aLink class southForm
  2019.         displayOn: aForm
  2020.         at: aForm offset
  2021.         clippingBox: aForm boundingBox
  2022.         rule: Form over
  2023.         mask: nil.
  2024.     aForm offset: self beginPoint x - compensate @ self beginPoint y.
  2025.     ^aForm! !
  2026.  
  2027.  
  2028. !SouthLine methodsFor: 'testing'!
  2029.  
  2030. horizontal
  2031.  ^false!
  2032.  
  2033. vertical
  2034.  ^true! !
  2035.  
  2036.  
  2037. !SouthLine methodsFor: 'box crossing'!
  2038.  
  2039. crossesBox: aDataFlowBox 
  2040.     "Return true if this SouthLine crosses aDataFlowBox,   
  2041.     false if not.  'Crosses' means 'stretches across the entire   
  2042.     height or width of aDataFlowBox'."
  2043.  
  2044.     | startPoint endPoint box |
  2045.     startPoint _ collectionOfPoints first.
  2046.     endPoint _ collectionOfPoints second.
  2047.     box _ aDataFlowBox boundingBox.
  2048.     ^startPoint x > box left and: [startPoint x < box right and: [startPoint y < box top and: [endPoint y > box bottom]]]! !
  2049.  
  2050. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2051.  
  2052. SouthLine class
  2053.     instanceVariableNames: ''!
  2054.  
  2055.  
  2056. !SouthLine class methodsFor: 'instance creation'!
  2057.  
  2058. from: sourcePoint to: destPoint withForm: aForm 
  2059.     "create an instance of SouthLine and initialize it"
  2060.  
  2061.     | aSouthLine |
  2062.     sourcePoint y > destPoint y
  2063.         ifTrue: [self error: 'line created with incorrect points'].
  2064.     aSouthLine _ super new.
  2065.     aSouthLine
  2066.         from: sourcePoint
  2067.         to: destPoint
  2068.         withForm: aForm.
  2069.      ^aSouthLine! !
  2070.  
  2071.  
  2072. FoibleLine subclass: #WestLine
  2073.     instanceVariableNames: ''
  2074.     classVariableNames: ''
  2075.     poolDictionaries: ''
  2076.     category: 'Foible'!
  2077.  
  2078.  
  2079. !WestLine methodsFor: 'form access'!
  2080.  
  2081. formFor: aLink 
  2082.     "return the form representing the receiver's image"
  2083.  
  2084.     | aForm compensate |
  2085.     compensate _ aLink class width // 2.
  2086.     aForm _ Form extent: (self beginPoint x - self endPoint x) asInteger @ aLink class width.
  2087.     aLink class westForm
  2088.         displayOn: aForm
  2089.         at: aForm offset
  2090.         clippingBox: aForm boundingBox
  2091.         rule: Form over
  2092.         mask: nil.
  2093.     aForm offset: self endPoint x @ (self endPoint y - compensate).
  2094.     ^aForm! !
  2095.  
  2096.  
  2097. !WestLine methodsFor: 'testing'!
  2098.  
  2099. horizontal
  2100.  ^true!
  2101.  
  2102. vertical
  2103.  ^false! !
  2104.  
  2105.  
  2106. !WestLine methodsFor: 'box crossing'!
  2107.  
  2108. crossesBox: aDataFlowBox 
  2109.     "Return true if this WestLine crosses aDataFlowBox,   
  2110.     false if not.  'Crosses' means 'stretches across the entire   
  2111.     height or width of aDataFlowBox'."
  2112.  
  2113.     | startPoint endPoint box |
  2114.     startPoint _ collectionOfPoints first.
  2115.     endPoint _ collectionOfPoints second.
  2116.     box _ aDataFlowBox boundingBox.
  2117.     ^startPoint y > box top and: [startPoint y < box bottom and: [startPoint x > box right and: [endPoint x < box left]]]! !
  2118.  
  2119. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2120.  
  2121. WestLine class
  2122.     instanceVariableNames: ''!
  2123.  
  2124.  
  2125. !WestLine class methodsFor: 'instance creation'!
  2126.  
  2127. from: sourcePoint to: destPoint withForm: aForm 
  2128.     "create an instance of WestLine and initialize it"
  2129.  
  2130.     | aWestLine |
  2131.     sourcePoint x < destPoint x
  2132.         ifTrue: [self error: 'line created with incorrect points'].
  2133.     aWestLine _ super new.
  2134.     aWestLine
  2135.         from: sourcePoint
  2136.         to: destPoint
  2137.         withForm: aForm.
  2138.      ^aWestLine! !
  2139.  
  2140.  
  2141. Object subclass: #FoibleDirectory
  2142.     instanceVariableNames: ''
  2143.     classVariableNames: ''
  2144.     poolDictionaries: ''
  2145.     category: 'Foible'!
  2146.  
  2147. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2148.  
  2149. FoibleDirectory class
  2150.     instanceVariableNames: ''!
  2151.  
  2152.  
  2153. !FoibleDirectory class methodsFor: 'form access'!
  2154.  
  2155. iconDirectory
  2156.     "return the directory that contains the icons for NullTool and FoibleLink"
  2157.  
  2158.     ^'/jindrich/icons'! !
  2159.  
  2160.  
  2161. Object subclass: #FoibleProgram
  2162.     instanceVariableNames: 'name managers '
  2163.     classVariableNames: ''
  2164.     poolDictionaries: ''
  2165.     category: 'Foible'!
  2166. FoibleProgram comment:
  2167. 'I am the top-level model (in the model-view-controller triad) for any 
  2168. visual program or environment written using Foible code.
  2169.  
  2170. Instance variables:
  2171.  
  2172.     name <String>
  2173.         name is displayed in the title bar of the window, and is also used as 
  2174.         the default filename when I am going to be stored.
  2175.     managers <OrderedCollection>
  2176.         a collection of the top-level FoibleManagers. there is one top-level
  2177.         FoibleManager for each canvas in an application.'!
  2178.  
  2179.  
  2180. !FoibleProgram methodsFor: 'changes'!
  2181.  
  2182. changeRequest
  2183.     "return whether we need an update, i.e. request confirmation from a 
  2184.     user when a layout is about to be closed"
  2185.  
  2186.     (self confirm: 'Save this layout before closing?')
  2187.         ifTrue: [self storeBinary. ^true]
  2188.         ifFalse: [^true]! !
  2189.  
  2190.  
  2191. !FoibleProgram methodsFor: 'accessing'!
  2192.  
  2193. firstManager
  2194.  
  2195.     ^managers first!
  2196.  
  2197. managerBoxes
  2198.  
  2199.     | boundingBoxes |
  2200.     boundingBoxes _ managers collect: [:aMgr | aMgr boundingBox].
  2201.     ^boundingBoxes!
  2202.  
  2203. name
  2204.     ^name!
  2205.  
  2206. name: aName
  2207.     name _ aName!
  2208.  
  2209. secondManager
  2210.  
  2211.     ^managers at: 2! !
  2212.  
  2213.  
  2214. !FoibleProgram methodsFor: 'initialize'!
  2215.  
  2216. initialize: aFoibleManager
  2217.     "Initialize the 'managers' instance variable of this new instance to
  2218.     be a FoibleManager"
  2219.  
  2220.     managers  _ OrderedCollection with: aFoibleManager.
  2221.     aFoibleManager program: self.
  2222.     self name: 'New Layout'!
  2223.  
  2224. initUsing: FoibleManager1 and: FoibleManager2
  2225.     "Initialize the 'managers' instance variable of this new instance to
  2226.     include FoibleManager1 and FoibleManager2"
  2227.  
  2228.     managers  _ OrderedCollection with: FoibleManager1 with: FoibleManager2.
  2229.     FoibleManager1 program: self.
  2230.     FoibleManager2 program: self.
  2231.     self name: 'NEW Layout'! !
  2232.  
  2233.  
  2234. !FoibleProgram methodsFor: 'saving'!
  2235.  
  2236. storeStructureOnFile: aFileName
  2237.  
  2238.     self storeBinaryOn: aFileName! !
  2239.  
  2240.  
  2241. !FoibleProgram methodsFor: 'public binary storage'!
  2242.  
  2243. storeBinary
  2244.     "Writes a description of the receiver into a file, in a way that allows
  2245.      the object's structure to be reconstructed from the file's contents."
  2246.  
  2247.     | fileName |
  2248.     fileName _ (FileDirectory currentDirectory)
  2249.                     requestFileName: 'Store binary on which file name?'
  2250.                     default: (self name, '.stbin')
  2251.                     version: #any
  2252.                     ifFail: [^nil].
  2253.     BinaryOutputManager store: self on: fileName! !
  2254.  
  2255. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2256.  
  2257. FoibleProgram class
  2258.     instanceVariableNames: ''!
  2259.  
  2260.  
  2261. !FoibleProgram class methodsFor: 'instance creation'!
  2262.  
  2263. readStructureFromFile: aFileName 
  2264.     "Read from a disk file a saved FoibleProgram whose instance variable 
  2265.     'managers' is initialized to be an OrderedCollection containing 
  2266.     one (or more) FoibleManagers.  The FoibleProgram must have been 
  2267.     saved with the binary storage package."
  2268.  
  2269.     | newFoibleProgram |
  2270.     newFoibleProgram _ BinaryInputManager readFrom: aFileName.
  2271.     ^newFoibleProgram!
  2272.  
  2273. with: aFoibleManager
  2274.     "Create an instance of a FoibleProgram whose instance variable
  2275.     'managers' is initialized to be an OrderedCollection containing
  2276.     one FoibleManager. Other instance creation methods (e.g.
  2277.     with: with:, etc.) could be installed if a FoibleProgram with multiple
  2278.     canvasses (and thus multiple FoibleManagers at the top level) is 
  2279.     desired."
  2280.  
  2281.     | newFoibleProgram |
  2282.     newFoibleProgram _ self new.
  2283.     newFoibleProgram initialize: aFoibleManager.
  2284.     ^newFoibleProgram!
  2285.  
  2286. with: FoibleManager1 with: FoibleManager2
  2287.     "Create an instance of a FoibleProgram whose instance variable
  2288.     'managers' is initialized to be an OrderedCollection containing
  2289.     FoibleManager1 and FoibleManager2"
  2290.  
  2291.     | newFoibleProgram |
  2292.     newFoibleProgram _ self new.
  2293.     newFoibleProgram initUsing: FoibleManager1 and: FoibleManager2.
  2294.     ^newFoibleProgram! !
  2295.  
  2296.  
  2297. Object subclass: #LineSession
  2298.     instanceVariableNames: 'lineClass stretchLine1 stretchLine2 cursorLoc '
  2299.     classVariableNames: ''
  2300.     poolDictionaries: ''
  2301.     category: 'Foible'!
  2302. LineSession comment:
  2303. 'I am the abstract class of functions that are performed on the form of a
  2304. FoibleLink. My subclasses are used to create and edit the FoibleLines that a
  2305. FoibleLink''s form consists of. I do not perform the cursor I/O, so the 
  2306. objects that create instances of me have to perform the cursor I/O and tell
  2307. me the location of the cursor.
  2308.  
  2309. Instance variables:
  2310.  
  2311.     lineClass <class>
  2312.         this holds the class of FoibleLine to create when new lines must be 
  2313.         created. it must either be FoibleLine or a subclass of FoibleLine.
  2314.     stretchLine1, stretchLine2 <type lineClass>
  2315.         these lines are displayed on the screen and may be accessed when 
  2316.         the line session has been completed.
  2317.     cursorLoc <Point>
  2318.         the last cursor location that I was told. I only modify my lines if I am
  2319.         told that the cursor is at a location different from cursorLoc. if it is, 
  2320.         then I update my lines, and set cursorLoc to the new location.'!
  2321.  
  2322.  
  2323. !LineSession methodsFor: 'line display'!
  2324.  
  2325. cursorAt: aPoint displayIn: aView
  2326.  
  2327.     aPoint = cursorLoc
  2328.      ifFalse: [
  2329.         self eraseIn: aView.
  2330.         cursorLoc _ aPoint.
  2331.         self redrawAt: aPoint displayIn: aView]!
  2332.  
  2333. displayIn: aView
  2334.     "display my lines in aView"
  2335.  
  2336.     self xorIn: aView!
  2337.  
  2338. eraseIn: aView
  2339.     "erase my lines in aClippingBox"
  2340.  
  2341.     self xorIn: aView!
  2342.  
  2343. redrawAt: aPoint
  2344.  
  2345.     self subclassResponsibility!
  2346.  
  2347. redrawAt: aPoint displayIn: aView
  2348.     "calculate the new line positions, given the cursor location, and display the lines"    
  2349.  
  2350.     self redrawAt: aPoint.
  2351.     self displayIn: aView!
  2352.  
  2353. xorIn: aView
  2354.  
  2355.     self subclassResponsibility! !
  2356.  
  2357.  
  2358. !LineSession methodsFor: 'accessing'!
  2359.  
  2360. defaultLineClass
  2361.     "answer the type of line to use"
  2362.  
  2363.     ^lineClass!
  2364.  
  2365. defaultLineClass: aClass
  2366.     "set the type of line to use"
  2367.  
  2368.     lineClass _ aClass! !
  2369.  
  2370.  
  2371. LineSession subclass: #LineDrawingSession
  2372.     instanceVariableNames: 'line1Horiz '
  2373.     classVariableNames: ''
  2374.     poolDictionaries: ''
  2375.     category: 'Foible'!
  2376. LineDrawingSession comment:
  2377. 'I am used to create links between boxes. After the first segement of a link 
  2378. is drawn, there are two moveable lines that change according to the cursor
  2379. location. I compute, store and display those lines.
  2380.  
  2381. Instance variables:
  2382.  
  2383.     line1Horiz <Boolean>
  2384.         is true if stretchLine1 should be horizontal, false if it should be 
  2385.         vertical.'!
  2386.  
  2387.  
  2388. !LineDrawingSession methodsFor: 'line display'!
  2389.  
  2390. redrawAt: aPoint
  2391. "calculate the new line positions, given the cursor location"    
  2392.  
  2393.     | endpt |
  2394.     line1Horiz
  2395.         ifTrue: [endpt _ (aPoint x)@(stretchLine1 endPoint y)]
  2396.         ifFalse: [endpt _ (stretchLine1 endPoint x)@(aPoint y)].
  2397.     stretchLine1 _ self defaultLineClass from: stretchLine1 beginPoint to: endpt.
  2398.     stretchLine2 _ self defaultLineClass from: stretchLine1 endPoint to: aPoint!
  2399.  
  2400. xorIn: aView
  2401.     "xor my lines in aView"
  2402.  
  2403.     stretchLine1 xorInClippingBox: aView insetDisplayBox.
  2404.     stretchLine2 xorInClippingBox: aView insetDisplayBox! !
  2405.  
  2406.  
  2407. !LineDrawingSession methodsFor: 'accessing'!
  2408.  
  2409. lastLine
  2410.     ^stretchLine2! !
  2411.  
  2412.  
  2413. !LineDrawingSession methodsFor: 'instance creation'!
  2414.  
  2415. firstLine: aLine atCursor: aPoint
  2416.  
  2417.     cursorLoc _ aPoint shallowCopy.
  2418.     stretchLine1 _ aLine shallowCopy.
  2419.     line1Horiz _ stretchLine1 horizontal! !
  2420.  
  2421. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2422.  
  2423. LineDrawingSession class
  2424.     instanceVariableNames: ''!
  2425.  
  2426.  
  2427. !LineDrawingSession class methodsFor: 'instance creation'!
  2428.  
  2429. firstLine: firstLine atCursor: aPoint
  2430.  
  2431.     | aSession |
  2432.     aSession _ super new.
  2433.     aSession defaultLineClass: FoibleLine.
  2434.     ^aSession firstLine: firstLine atCursor: aPoint!
  2435.  
  2436. firstLine: firstLine atCursor: aPoint using: aLineClass
  2437.  
  2438.     | aSession |
  2439.     aSession _ super new.
  2440.     aSession defaultLineClass: aLineClass.
  2441.     ^aSession firstLine: firstLine atCursor: aPoint! !
  2442.  
  2443.  
  2444. LineSession subclass: #LineEditingSession
  2445.     instanceVariableNames: 'movingLine cutPoint initialBoundingBox '
  2446.     classVariableNames: ''
  2447.     poolDictionaries: ''
  2448.     category: 'Foible'!
  2449. LineEditingSession comment:
  2450. 'I am the abstract class of editing functions that are performed on the form 
  2451. of a FoibleLink. My subclasses are used to edit the FoibleLines that a 
  2452. FoibleLink''s form consists of. In a line editing session one segment of a 
  2453. FoibleLink''s form is translated, according to the current cursor location. 
  2454. This is segment is stored in my ''movingLine'' instance variable. The two 
  2455. segments that are connected to each end of this segment are stretched to 
  2456. keep a consistent and unbroken link. The lines that stretch are stored in my
  2457. instance variables ''stretchLine1'' and ''stretchLine2'', which I inherit from 
  2458. LineSession.
  2459.  
  2460. Instance variables:
  2461.  
  2462.     movingLine <type lineClass>
  2463.         see LineSession for description of my ''lineClass'' variable. this is the 
  2464.         line that tranlates when I am told that the cursor has moved.
  2465.     cutPoint <Point>
  2466.         this location is used to calculate the lines when the cursor moves.
  2467.     initialBoundingBox <Rectangle>
  2468.         stores the boundingBox of all of the lines that I am going to edit. 
  2469.         this Rectangle is then merged with the boundingBoxes of the lines 
  2470.         after editing is complete, to give the total area that needs to be 
  2471.         updated on the screen. Also, if the editing session is aborted, then 
  2472.         this area still needs to be updated on the screen.'!
  2473.  
  2474.  
  2475. !LineEditingSession methodsFor: 'line display'!
  2476.  
  2477. redrawAt: aPoint
  2478.     "calculate the new line positions, given the cursor location"    
  2479.  
  2480.     ((stretchLine1 vertical) & (self movingHoriz) ) 
  2481.         ifTrue:[stretchLine1_ self defaultLineClass
  2482.                                     from: stretchLine1 beginPoint 
  2483.                                     to: stretchLine1 beginPoint x @ (aPoint y).
  2484.                 stretchLine2_ self defaultLineClass from: cutPoint x @ (aPoint y) to: cutPoint.]
  2485.         ifFalse:[stretchLine1_ self defaultLineClass
  2486.                                     from: stretchLine1 beginPoint 
  2487.                                     to: aPoint x @ (stretchLine1 beginPoint y).
  2488.                 stretchLine2_ self defaultLineClass from: aPoint x @ (cutPoint y) to: cutPoint.].
  2489.     movingLine_ self defaultLineClass from: stretchLine1 endPoint to: stretchLine2 beginPoint.!
  2490.  
  2491. xorIn: aView
  2492.     "xor my lines in aView"
  2493.  
  2494.     stretchLine1 xorInClippingBox: aView insetDisplayBox.
  2495.     movingLine xorInClippingBox: aView insetDisplayBox.
  2496.     stretchLine2 xorInClippingBox: aView insetDisplayBox.! !
  2497.  
  2498.  
  2499. !LineEditingSession methodsFor: 'accessing'!
  2500.  
  2501. boundingBox
  2502.  
  2503.     | aRect |
  2504.     self lines isNil ifTrue: [^nil].
  2505.     aRect _ self lines first relativeRectangle.
  2506.     self lines do: [:each | aRect _ aRect merge: each relativeRectangle].
  2507.     ^aRect!
  2508.  
  2509. initialBoundingBox
  2510.  
  2511.     ^initialBoundingBox!
  2512.  
  2513. lines
  2514.     "return an OrderedCollection of my lines"
  2515.  
  2516.     | theLines |
  2517.     theLines_OrderedCollection new.
  2518.     theLines add: stretchLine1.
  2519.     theLines add: movingLine.
  2520.     theLines add: stretchLine2.
  2521.     ^theLines!
  2522.  
  2523. movingHoriz
  2524.  
  2525.     movingLine isNil
  2526.         ifFalse:[^movingLine horizontal].
  2527.     ^true! !
  2528.  
  2529.  
  2530. LineEditingSession subclass: #LineCuttingSession
  2531.     instanceVariableNames: 'cutLineLeft '
  2532.     classVariableNames: ''
  2533.     poolDictionaries: ''
  2534.     category: 'Foible'!
  2535. LineCuttingSession comment:
  2536. 'I am a line editing function that cuts one segment of a link into two 
  2537. segments and adds a new segment between them. After the cut is made 
  2538. the display on the screen is similar to LineMovingSession.
  2539.  
  2540. Instance variables:
  2541.  
  2542.     cutLineLeft <type lineClass>
  2543.         this is the second segment that is created when a line is cut. the first
  2544.         segment is stored in ''movingLine'', which is inherited from 
  2545.         LineEditingSession.'!
  2546.  
  2547.  
  2548. !LineCuttingSession methodsFor: 'instance creation'!
  2549.  
  2550. cutLine: cutLine atCursor: aPoint clippingBox: aClippingBox
  2551.  
  2552.     cutLine prev isNil ifTrue: [self error: 'cannot cut this line'].
  2553.     cursorLoc _ aPoint.
  2554.     stretchLine1 _ cutLine prev.
  2555.     cutLine vertical
  2556.         ifTrue:[cutPoint_cutLine endPoint x @ aPoint y]
  2557.         ifFalse:[cutPoint_aPoint x @ cutLine endPoint y].
  2558.     cutPoint_cutPoint.
  2559.     cutLineLeft_ self defaultLineClass from: cutPoint to: cutLine endPoint.
  2560.     cutLineLeft xorInClippingBox: aClippingBox.
  2561.     initialBoundingBox _ cutLine prev relativeRectangle merge: cutLine relativeRectangle! !
  2562.  
  2563.  
  2564. !LineCuttingSession methodsFor: 'accessing'!
  2565.  
  2566. lines
  2567. "return an OrderedCollection of my lines"
  2568.     | theLines |
  2569.     theLines_OrderedCollection new.
  2570.     theLines add: stretchLine1.
  2571.     theLines add: movingLine.
  2572.     theLines add: stretchLine2.
  2573.     theLines add: cutLineLeft.
  2574.     ^theLines! !
  2575.  
  2576. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2577.  
  2578. LineCuttingSession class
  2579.     instanceVariableNames: ''!
  2580.  
  2581.  
  2582. !LineCuttingSession class methodsFor: 'instance creation'!
  2583.  
  2584. cutLine: cutLine atCursor: aPoint clippingBox: aClippingBox
  2585.  
  2586.     | aSession |
  2587.     aSession _ super new.
  2588.     aSession defaultLineClass: FoibleLine.
  2589.     ^aSession cutLine: cutLine atCursor: aPoint clippingBox: aClippingBox!
  2590.  
  2591. cutLine: cutLine atCursor: aPoint clippingBox: aClippingBox using: aLineClass
  2592.  
  2593.     | aSession |
  2594.     aSession _ super new.
  2595.     aSession defaultLineClass: aLineClass.
  2596.     ^aSession cutLine: cutLine atCursor: aPoint clippingBox: aClippingBox! !
  2597.  
  2598.  
  2599. LineEditingSession subclass: #LineMovingSession
  2600.     instanceVariableNames: ''
  2601.     classVariableNames: ''
  2602.     poolDictionaries: ''
  2603.     category: 'Foible'!
  2604. LineMovingSession comment:
  2605. 'I am a line editing function that moves one segment of a link, while 
  2606. stretching the segments on either side of it.'!
  2607.  
  2608.  
  2609. !LineMovingSession methodsFor: 'instance creation'!
  2610.  
  2611. moveLine: aLine atCursor: cursorPoint
  2612.  
  2613.     aLine prev isNil ifTrue: [self error: 'cannot move this line'].
  2614.     aLine next isNil ifTrue: [self error: 'cannot move this line'].
  2615.     cursorLoc _ cursorPoint shallowCopy.
  2616.     stretchLine1 _ aLine prev shallowCopy.
  2617.     cutPoint _ aLine next endPoint shallowCopy.
  2618.     initialBoundingBox _ aLine prev relativeRectangle 
  2619.                         merge: (aLine relativeRectangle merge: aLine next relativeRectangle)! !
  2620.  
  2621. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2622.  
  2623. LineMovingSession class
  2624.     instanceVariableNames: ''!
  2625.  
  2626.  
  2627. !LineMovingSession class methodsFor: 'instance creation'!
  2628.  
  2629. moveLine: aLine atCursor: aPoint
  2630.  
  2631.     | aSession |
  2632.     aSession _ super new.
  2633.     aSession defaultLineClass: FoibleLine.
  2634.     ^aSession moveLine: aLine atCursor: aPoint!
  2635.  
  2636. moveLine: aLine atCursor: aPoint using: aLineClass
  2637.  
  2638.     | aSession |
  2639.     aSession _ super new.
  2640.     aSession defaultLineClass: aLineClass.
  2641.     ^aSession moveLine: aLine atCursor: aPoint! !
  2642.  
  2643.  
  2644. Object subclass: #Port
  2645.     instanceVariableNames: 'boundingBox link box '
  2646.     classVariableNames: ''
  2647.     poolDictionaries: ''
  2648.     category: 'Foible'!
  2649. Port comment:
  2650. 'I am the class that represents one possible way of which links are 
  2651. connected to boxes. Ports can be thought of as the pins on a chip, while 
  2652. FoibleLinks are the wires between chips.
  2653.  
  2654. Instance variables:
  2655.  
  2656.     boundingBox <Rectangle>
  2657.         the area on a box that I am associated with.
  2658.     link <FoibleLink>
  2659.         the link that is connected to me.
  2660.     box <FoibleBox>
  2661.         the box that I am associated with.
  2662. '!
  2663.  
  2664.  
  2665. !Port methodsFor: 'accessing'!
  2666.  
  2667. boundingBox
  2668.     "return value of the receiver's bounding box"
  2669.  
  2670.     ^Rectangle origin: boundingBox origin + self box offset extent: boundingBox extent!
  2671.  
  2672. boundingBox: aRectangle 
  2673.     "set value of the receiver's bounding box"
  2674.  
  2675.     boundingBox _ aRectangle!
  2676.  
  2677. box 
  2678.     "retreive the pointer to the foible box to which this port belongs"
  2679.  
  2680.     ^box!
  2681.  
  2682. box: aFoibleBox 
  2683.     "store a pointer to the foible box to which this port belongs"
  2684.  
  2685.     box _ aFoibleBox!
  2686.  
  2687. extent
  2688.     "return extent of the receiver's bounding box"
  2689.  
  2690.     ^self boundingBox extent!
  2691.  
  2692. link
  2693.     "return value of the receiver's link"
  2694.  
  2695.     ^link!
  2696.  
  2697. link: aLink 
  2698.     "set value of the receiver's link"
  2699.  
  2700.     link _ aLink!
  2701.  
  2702. name
  2703.     "return name of the receiver's foible box"
  2704.  
  2705.     ^self box name!
  2706.  
  2707. offset
  2708.     "return offset of the receiver's bounding box"
  2709.  
  2710.     ^self boundingBox origin! !
  2711.  
  2712.  
  2713. !Port methodsFor: 'adding'!
  2714.  
  2715. addLink: aBoxLink 
  2716.     "set the receiver's link to be aBoxLink and send the 
  2717.     message on to the receiver's box"
  2718.  
  2719.     link _ aBoxLink.
  2720.     (box isKindOf: BoxWithDirectLinks)
  2721.         ifTrue: [box addLink: aBoxLink]! !
  2722.  
  2723.  
  2724. !Port methodsFor: 'removing'!
  2725.  
  2726. removeLink: aBoxLink
  2727.     "remove aBoxLink from the set of links belonging to the receiver's box as         well as setting the receiver's link to nil"
  2728.  
  2729.     link _ nil.
  2730.     (box isKindOf: BoxWithDirectLinks)
  2731.         ifTrue: [box removeLink: aBoxLink]! !
  2732.  
  2733. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2734.  
  2735. Port class
  2736.     instanceVariableNames: ''!
  2737.  
  2738.  
  2739. !Port class methodsFor: 'instance creation'!
  2740.  
  2741. new: aRectangle 
  2742.     "create a new port with a bounding box of size aRectangle"
  2743.  
  2744.     | aPort |
  2745.     aPort _ self new.
  2746.     aPort boundingBox: aRectangle.
  2747.     ^aPort! !
  2748.  
  2749.  
  2750. Port subclass: #InputPort
  2751.     instanceVariableNames: ''
  2752.     classVariableNames: ''
  2753.     poolDictionaries: ''
  2754.     category: 'Foible'!
  2755. InputPort comment:
  2756. 'I am the class of Ports that connects with a link that is coming from 
  2757. another box. So, I accept input from another box. At most, one link can be
  2758. connected to me at any time.'!
  2759.  
  2760.  
  2761. Port subclass: #OutputPort
  2762.     instanceVariableNames: ''
  2763.     classVariableNames: ''
  2764.     poolDictionaries: ''
  2765.     category: 'Foible'!
  2766. OutputPort comment:
  2767. 'I am the class of Ports that connects with links that are coming from my 
  2768. box. I send output to other boxes. There is no limit to the number of links 
  2769. that can be connected to me at a any time. To allow for this, the ''link'' 
  2770. variable that I inherit from Port is now an OrderedCollection of the links 
  2771. that are connected to me.'!
  2772.  
  2773.  
  2774. !OutputPort methodsFor: 'removing'!
  2775.  
  2776. removeLink: aBoxLink
  2777.     "remove aBoxLink from the set of links belonging to the receiver's 
  2778.     box, as well as setting the receiver's link to nil"
  2779.  
  2780.     link remove: aBoxLink.
  2781.     (box isKindOf: BoxWithDirectLinks)
  2782.         ifTrue: [box removeLink: aBoxLink]! !
  2783.  
  2784.  
  2785. !OutputPort methodsFor: 'adding'!
  2786.  
  2787. addLink: aBoxLink
  2788.     "add aBoxLink to the receiver's 'link' instance variable and send the
  2789.     message on to the receiver's box"
  2790.  
  2791.     link isNil ifTrue: [link _ OrderedCollection with: aBoxLink]
  2792.                 ifFalse: [link add: aBoxLink].
  2793.     (box isKindOf: BoxWithDirectLinks)
  2794.         ifTrue: [box addLink: aBoxLink]! !
  2795.  
  2796.  
  2797. Object subclass: #ProtoLink
  2798.     instanceVariableNames: 'origin destination lines '
  2799.     classVariableNames: ''
  2800.     poolDictionaries: ''
  2801.     category: 'Foible'!
  2802.  
  2803.  
  2804. !ProtoLink methodsFor: 'accessing'!
  2805.  
  2806. destination 
  2807.     "return the destination of the ProtoLink"
  2808.  
  2809.     ^destination!
  2810.  
  2811. destination: toThing 
  2812.     "assign toThing as the destination of the ProtoLink"
  2813.  
  2814.     destination _ toThing!
  2815.  
  2816. lines 
  2817.     "return the ordered collection of lines of the ProtoLink"
  2818.  
  2819.     ^lines!
  2820.  
  2821. lines: anOrderedCollection 
  2822.     "assign anOrderedCollection to be the set of lines of the ProtoLink"
  2823.  
  2824.     lines _ anOrderedCollection!
  2825.  
  2826. origin 
  2827.     "return the origin of the ProtoLink"
  2828.  
  2829.     ^origin!
  2830.  
  2831. origin: fromThing 
  2832.     "assign fromThing as the origin of the ProtoLink"
  2833.  
  2834.     origin _ fromThing!
  2835.  
  2836. origin: fromThing destination: toThing lines: anOrderedCollection
  2837.     self origin: fromThing.
  2838.     self destination: toThing.
  2839.     self lines: anOrderedCollection! !
  2840.  
  2841.  
  2842. Object subclass: #Tool
  2843.     instanceVariableNames: 'model view controller wantsControl '
  2844.     classVariableNames: ''
  2845.     poolDictionaries: ''
  2846.     category: 'Foible'!
  2847. Tool comment:
  2848. 'My instances perform operations on Foibles in an application.
  2849.  
  2850. Instance variables:
  2851.  
  2852.     model <FoibleManager>
  2853.     view <CanvasView>
  2854.     controller <ToolController>
  2855.     wantsControl <Boolean>'!
  2856.  
  2857.  
  2858. !Tool methodsFor: 'initialize'!
  2859.  
  2860. initializeWithModel: aModel view: aView controller: aController
  2861.  
  2862.     self model: aModel.
  2863.     self view: aView.
  2864.     self controller: aController.
  2865.     self startUp.!
  2866.  
  2867. startUp
  2868.     "initialize self"
  2869.  
  2870.     self installMenu.
  2871.     self class cursor isNil ifTrue: [self class initialize].
  2872.     model cursor: self class cursor.
  2873.     wantsControl _ true! !
  2874.  
  2875.  
  2876. !Tool methodsFor: 'menu setup'!
  2877.  
  2878. installMenu
  2879.     
  2880.     controller yellowButtonMenu: 
  2881.         (PopUpMenu labels: 'add
  2882. delete
  2883. layout'
  2884.                 lines: #(2))
  2885.         yellowButtonMessages: #(add delete layout).! !
  2886.  
  2887.  
  2888. !Tool methodsFor: 'menu messages'!
  2889.  
  2890. add
  2891.  
  2892.     ^self subclassResponsibility!
  2893.  
  2894. delete
  2895.     "Find an object and remove it from list, return nil if no find"
  2896.  
  2897.     | aPoint aThing aRectangle  |
  2898.     aPoint _ self getPoint: (Cursor crossHair offset: -7 @ -9).
  2899.     aPoint isNil ifTrue: [^nil].
  2900.     "User aborted"
  2901.     aThing _ model find: aPoint suchThat: [:it | it canBeDeleted].
  2902.     aThing isNil ifTrue: [^nil].
  2903.     "No such object"
  2904.     (BinaryChoice message: 'Really delete
  2905. ' , aThing name , '?')
  2906.         ifFalse: [^nil].
  2907.     aRectangle _ aThing owner remove: aThing.
  2908.     model changed: aRectangle.!
  2909.  
  2910. getPath
  2911.     "Allow the user to draw the path between the two boxes   
  2912.     (with appropriate conditions) and return the path"
  2913.  
  2914.     ^self
  2915.         pathFrom: [:it :point | it givesDataLinks: point]
  2916.         to: [:it :point | it acceptsDataLinks: point]
  2917.         width: self defaultLinkClass width
  2918.         both: [:a :b | a box ~= b box]!
  2919.  
  2920. layout
  2921.     "Allow the user to select layout options - new, old, save"
  2922.  
  2923.     | string result |
  2924.     string _ 'create a blank layout
  2925. open an old layout'.
  2926.     model isEmpty ifFalse: [string _ string , '
  2927. save this layout'].
  2928.     result _ (PopUpMenu labels: string) startUp.
  2929.     result = 0 ifTrue: [^nil].
  2930.     result = 1 ifTrue: [^(view superView class) open "new window on new FoibleProgram"].
  2931.     result = 2
  2932.         ifTrue: [self open]
  2933.         ifFalse: [self save]!
  2934.  
  2935. redButtonActivity
  2936.     ^self! !
  2937.  
  2938.  
  2939. !Tool methodsFor: 'private'!
  2940.  
  2941. cursor: aPoint inRect: aRect
  2942.     "Return the proper cursorpoint to keep it in aRect"
  2943.  
  2944.     | point  |
  2945.     point _ aPoint deepCopy.
  2946.     (aRect containsPoint: point)
  2947.         ifFalse: [
  2948.             point x: ((point x max: ((aRect left) + 5)) min: ((aRect right) - 5)).
  2949.             point y: ((point y max: ((aRect top) + 5)) min: ((aRect bottom) - 5)).
  2950.             Sensor cursorPoint: point.
  2951.         ].
  2952.  
  2953.     ^point!
  2954.  
  2955. cursorInRect: aRect
  2956.     "Return the proper cursorpoint to keep it in aRect"
  2957.  
  2958.     ^self cursor: Sensor cursorPoint inRect: aRect!
  2959.  
  2960. cursorInView: aView linkWidth: width
  2961.     "Return a point in aView's coordinates"
  2962.  
  2963.     ^ aView inverseDisplayTransform: (self cursor: Sensor cursorPoint inRect: (self insetView: aView byWidth: width))!
  2964.  
  2965. getPoint
  2966.     "Get a point in the viewport and return its value, nil if left the viewport,
  2967.         using crosshair cursor"
  2968.  
  2969.     ^self getPoint: Cursor crossHair!
  2970.  
  2971. getPoint: aCursor
  2972.     "Get a point in the viewport and return its value, nil if left the viewport"
  2973.  
  2974.     | aPoint |
  2975.     aCursor show.
  2976.     [ Sensor noButtonPressed & controller isControlActive ]
  2977.             whileTrue: [aPoint _ Sensor cursorPoint].
  2978.  
  2979.     model cursor show.
  2980.     controller isControlActive ifFalse: [^nil].
  2981.     ^(view inverseDisplayTransform: (Sensor waitClickButton)) rounded!
  2982.  
  2983. getThingArea: aDisplayObject 
  2984.     "Get a point in the viewport valid for aDisplayObject.  
  2985.     aDisplayObject is only allowed to move around so that its 
  2986.     whole area is totally within the viewport at all times.  
  2987.     Return a rectangle which represents the area of 
  2988.     aDisplayObject, but return nil if have left the viewport."
  2989.  
  2990.     | aPoint viewRect |
  2991.     viewRect _ view insetDisplayBox deepCopy.
  2992.     viewRect _ Rectangle origin: viewRect origin extent: viewRect extent - aDisplayObject extent.
  2993.     Cursor blank showWhile: [aDisplayObject follow: [self cursorInRect: viewRect]
  2994.             while: [Sensor noButtonPressed]].
  2995.     Sensor redButtonPressed
  2996.         ifFalse: 
  2997.             [Sensor waitClickButton.    "Keep other menus from popping up"
  2998.             ^nil].
  2999.     aPoint _ (view inverseDisplayTransform: Sensor waitClickButton) rounded.
  3000.     Sensor cursorPoint: Sensor cursorPoint + aDisplayObject computeBoundingBox center.
  3001.     ^aPoint extent: aDisplayObject boundingBox extent!
  3002.  
  3003. getThingPoint: aDisplayObject 
  3004.     "Get a point in the viewport valid for aDisplayObject totally  
  3005.     within the viewport.  Return its value, nil if left the viewport"
  3006.  
  3007.     | aPoint viewRect |
  3008.  
  3009.     viewRect _ view insetDisplayBox deepCopy.
  3010.     viewRect _ Rectangle origin: viewRect origin
  3011.                     extent: (viewRect extent) - (aDisplayObject extent).
  3012.     Cursor blank showWhile: [aDisplayObject
  3013.             follow: [self cursorInRect: viewRect]
  3014.             while: [Sensor noButtonPressed]].
  3015.     (Sensor redButtonPressed)
  3016.         ifFalse: [
  3017.             Sensor waitClickButton.        "Keep other menus from popping up"
  3018.             ^nil].
  3019.     aPoint _ (view inverseDisplayTransform: Sensor waitClickButton) rounded.
  3020.  
  3021.     Sensor cursorPoint: Sensor cursorPoint + 
  3022.         aDisplayObject computeBoundingBox center.
  3023.     ^aPoint!
  3024.  
  3025. insetView: aView byWidth: width
  3026.  
  3027.     ^(aView insetDisplayBox deepCopy) insetBy: ((width // 2) + 1)! !
  3028.  
  3029.  
  3030. !Tool methodsFor: 'access'!
  3031.  
  3032. controller: aController
  3033.  
  3034.     controller _ aController.!
  3035.  
  3036. defaultLineClass
  3037.     "answer the type of line to use"
  3038.  
  3039.     ^FoibleLine!
  3040.  
  3041. defaultLinkClass
  3042.     "answer the type of link to use"
  3043.  
  3044.     ^FoibleLink!
  3045.  
  3046. model: aModel
  3047.  
  3048.     model _ aModel.!
  3049.  
  3050. program
  3051.  
  3052.     ^ model program!
  3053.  
  3054. view: aView
  3055.  
  3056.     view _ aView.! !
  3057.  
  3058.  
  3059. !Tool methodsFor: 'control defaults'!
  3060.  
  3061. isControlActive
  3062.  
  3063.     ^wantsControl! !
  3064.  
  3065.  
  3066. !Tool methodsFor: 'basic control sequence'!
  3067.  
  3068. controlInitialize
  3069.  
  3070.     wantsControl _ true.!
  3071.  
  3072. controlTerminate
  3073.  
  3074.     wantsControl _ true.! !
  3075.  
  3076.  
  3077. !Tool methodsFor: 'line creation-modification'!
  3078.  
  3079. eraseNewPath: theLines in: aClippingBox
  3080.     | lines |
  3081.     (theLines size > 2)   "get rid of displayed lines"
  3082.         ifTrue: [lines _ theLines deepCopy.
  3083.                 lines removeLast.
  3084.                 lines removeLast.
  3085.                 lines do: [:each | each xorInClippingBox: aClippingBox]].!
  3086.  
  3087. fixLastLine: theLines toBox: aBox
  3088.  
  3089.     | aLine |
  3090.     aLine _ theLines last.
  3091.     theLines removeLast.  "may end in middle of box, so fix it"
  3092.     aLine _ self lineToBox: aBox from: (aLine beginPoint).
  3093.     theLines addLast: aLine.
  3094.     ^theLines!
  3095.  
  3096. getEndingPoint: aLine from: source toCondition: toCondition bothCondition: bothCondition 
  3097.     "allow the user to select the ending point of a link"
  3098.  
  3099.     | toThing destination |
  3100.     toThing _ model find: aLine endPoint suchThatTwo: toCondition.
  3101.     toThing isNil
  3102.         ifTrue: [^nil].
  3103.     toThing hasPorts
  3104.         ifTrue: [destination _ toThing findInputPort: aLine endPoint]
  3105.         ifFalse: [destination _ toThing].
  3106.     (bothCondition value: destination value: source)
  3107.                 ifFalse: [destination _ nil].
  3108.     "They do not fit together"
  3109.     ^destination!
  3110.  
  3111. getStartingPoint: fromCondition 
  3112.     "let the user choose the starting location of the path of a link
  3113.      if the chosen box is a BoxWithPorts, then try to find an available port to return,
  3114.      if the chosen box is a BoxWithDirectLinks, then just return the entire box"
  3115.  
  3116.     | aPoint fromFoibleBox source |
  3117.     aPoint _ self getPoint: (Cursor crossHair offset: -7 @ -7).
  3118.     aPoint isNil ifTrue: [^nil].
  3119.     fromFoibleBox _ model find: aPoint suchThatTwo: fromCondition.
  3120.     fromFoibleBox isNil ifTrue: [^nil].
  3121.     fromFoibleBox hasPorts
  3122.         ifTrue: [source _ fromFoibleBox findOutputPort: aPoint]
  3123.         ifFalse: [source _ fromFoibleBox].
  3124.     ^source!
  3125.  
  3126. lineFromBox: aFoibleBox to: point
  3127.     " Make a straight line out of the given FoibleBox to point,
  3128.         absolute coordinates"
  3129.  
  3130.     | big beginPoint flowRect deltaLeft deltaRight deltaTop deltaBottom |
  3131.  
  3132.     flowRect _ aFoibleBox boundingBox.
  3133.     deltaLeft _ (flowRect left) - (point x).
  3134.     deltaRight _ (point x) - (flowRect right).
  3135.     deltaTop _ (flowRect top) - (point y).
  3136.     deltaBottom _ (point y) - (flowRect bottom).
  3137.     big _ (deltaLeft max: deltaRight) max: (deltaTop max: deltaBottom).
  3138.     big = deltaLeft
  3139.         ifTrue: [beginPoint _ (flowRect left) @
  3140.                     ((point y min: flowRect bottom) max: flowRect top).
  3141.                     point y: beginPoint y]
  3142.         ifFalse: [big = deltaRight
  3143.             ifTrue: [beginPoint _ (flowRect right)@
  3144.                     ((point y min: flowRect bottom) max: flowRect top).
  3145.                     point y: beginPoint y]
  3146.             ifFalse: [big = deltaTop
  3147.                 ifTrue: [beginPoint _  "big = deltaTop"
  3148.                         ((point x min: flowRect right) max: flowRect left)@
  3149.                             (flowRect top).
  3150.                         point x: beginPoint x]
  3151.                 ifFalse: [beginPoint _ "big = deltaBottom"
  3152.                         ((point x min: flowRect right) max: flowRect left)@
  3153.                             (flowRect bottom).
  3154.                         point x: beginPoint x]]].
  3155.  
  3156.     (flowRect containsPoint: point)
  3157.         ifTrue: [^self defaultLineClass from: beginPoint to: beginPoint]
  3158.         ifFalse: [^self defaultLineClass from: beginPoint to: point].!
  3159.  
  3160. lineFromBox: aFoibleBox to: point displayIn: aClippingBox
  3161.     "Make a straight line out of the given FoibleBox to point, absolute coordinates,
  3162.       and display it"
  3163.  
  3164.     | aFoibleLine |
  3165.     aFoibleLine _ self lineFromBox: aFoibleBox to: point.
  3166.     aFoibleLine xorInClippingBox: aClippingBox.
  3167.     ^aFoibleLine!
  3168.  
  3169. lineOutOfBox: aFoibleBox width: width
  3170.     " Allow the user to designate a straight line out fo the given FoibleBox,
  3171.         aware of the eventual line width"
  3172.  
  3173.     | line point oldPoint |
  3174.     point _ self cursorInView: view linkWidth: width.
  3175.     oldPoint _ point.
  3176.     line _ self lineFromBox: aFoibleBox to: point displayIn: view insetDisplayBox.
  3177.     [Sensor noButtonPressed] whileTrue:
  3178.         [point _ self cursorInView: view linkWidth: width.
  3179.         (point = oldPoint) ifFalse: [
  3180.             line xorInClippingBox: view insetDisplayBox. "erase"
  3181.             oldPoint _ point deepCopy.
  3182.             line _ self lineFromBox: aFoibleBox to: point displayIn: view insetDisplayBox.
  3183.             ]].
  3184.     point _ self cursorInView: view linkWidth: width.
  3185.     line xorInClippingBox: view insetDisplayBox. "erase"
  3186.  
  3187.     (Sensor redButtonPressed) 
  3188.         ifTrue: [line _ self lineFromBox: aFoibleBox to: point]
  3189.         ifFalse: [line _ nil].
  3190.     Sensor waitNoButton.    "Wait for click - avoid annoying menus"
  3191.     ^line!
  3192.  
  3193. lineSession: aSession width: width
  3194.     " let the user alter the straight lines:  aLine gets stretched, a perpendicular line 
  3195.       is maintained to aLine, and a line is stretched from cutPoint to the 
  3196.       perpendicular "
  3197.  
  3198.     | point |
  3199.     point _ self cursorInView: view linkWidth: width.
  3200.     aSession redrawAt: point displayIn: view.
  3201.  
  3202.     [Sensor noButtonPressed] whileTrue:
  3203.         [point _  self cursorInView: view linkWidth: width.
  3204.         aSession cursorAt: point displayIn: view].
  3205.  
  3206.     point _ self cursorInView: view linkWidth: width.
  3207.     aSession redrawAt: point displayIn: view.
  3208.  
  3209.     (Sensor redButtonPressed)
  3210.         ifFalse: [^nil]. "user aborted"
  3211.     Sensor waitNoButton.    "avoid the click that leads to menus"
  3212.     ^aSession!
  3213.  
  3214. lineToBox: aFoibleBox from: point
  3215.     " Reverse the direction of the line generated by lineFROM...."
  3216.  
  3217.     | line |
  3218.     line _ self lineFromBox: aFoibleBox to: point.
  3219.     ^self defaultLineClass from: line endPoint to: line beginPoint!
  3220.  
  3221. moveLine: aLink point: aPoint
  3222.     " allow the user edit aLink"
  3223.  
  3224.     | point viewRect firstSegment secondSegment session box |
  3225.     firstSegment_aLink formAtPoint: aPoint.    
  3226.     firstSegment next isNil ifTrue: [^nil].
  3227.  
  3228.     viewRect _ view insetDisplayBox.
  3229.     firstSegment formToLineInClippingBox: viewRect.
  3230.  
  3231.     point _ self getPoint: Cursor currentCursor.
  3232.     point isNil ifTrue: [^firstSegment displayForm relativeRectangle].
  3233.     secondSegment _ aLink formAtPoint: point.
  3234.     firstSegment xorInClippingBox: viewRect.
  3235.     secondSegment isNil ifTrue: [^firstSegment displayForm relativeRectangle].
  3236.  
  3237.     (secondSegment=(firstSegment next))
  3238.         ifTrue: [secondSegment eraseFormInClipBox: viewRect.
  3239.                 session_LineCuttingSession
  3240.                             cutLine: secondSegment 
  3241.                             atCursor: point
  3242.                             clippingBox: viewRect
  3243.                             using: self defaultLineClass]
  3244.         ifFalse:[secondSegment=firstSegment
  3245.                     ifTrue:[(firstSegment prev) isNil 
  3246.                                 ifTrue: [^firstSegment displayForm relativeRectangle].
  3247.                             firstSegment prev eraseFormInClipBox: viewRect.
  3248.                             firstSegment next eraseFormInClipBox: viewRect.
  3249.                             session_LineMovingSession moveLine: firstSegment
  3250.                                     atCursor: point
  3251.                                     using: self defaultLineClass]
  3252.                     ifFalse: [^firstSegment displayForm relativeRectangle]].
  3253.     box _ session initialBoundingBox.
  3254.     (self lineSession: session width: self defaultLinkClass width) notNil
  3255.         ifTrue: [aLink replacePathFromLine: secondSegment prev
  3256.                     toLine: firstSegment next
  3257.                     withLines: session lines    .
  3258.                 box _ box merge: session boundingBox].
  3259.     ^box!
  3260.  
  3261. pathFrom: fromCondition to: toCondition width: width both: bothCondition
  3262.     "Let the user specify a path from a Foible that satisfies fromCondition 
  3263.         to a Foible that satisfies toCondition while both satisfy 
  3264.         bothCondition, using width to keep in proper boundaries.
  3265.     Returns a ProtoLink containing the source, the lines that form the 
  3266.         path and the destination."
  3267.  
  3268.     | source destination aLine lines |
  3269.     source _ self getStartingPoint: fromCondition.
  3270.     source isNil ifTrue: [^nil].    "No such FoibleBox"
  3271.  
  3272.     lines _ OrderedCollection new.
  3273.     aLine _ self lineOutOfBox: source width: width.
  3274.     aLine isNil ifTrue: [^nil].    "User aborted"
  3275.  
  3276.     lines add: aLine.
  3277.      destination _ self getEndingPoint: aLine from: source toCondition: toCondition bothCondition: bothCondition.
  3278.     
  3279.     [(destination isNil) & (aLine isNil not)]
  3280.      whileTrue: 
  3281.         [aLine _ lines last deepCopy.
  3282.         (lines size > 1) 
  3283.             ifTrue: [ (lines before: lines last) xorInClippingBox: view insetDisplayBox. "display fixed line"].
  3284.         aLine _ self straightLiner: aLine width: width.
  3285.         aLine isNil 
  3286.             ifTrue:         "User aborted"
  3287.                  [lines addLast: lines last deepCopy.    "for display removal"]
  3288.             ifFalse: 
  3289.                 [lines last endPoint: aLine beginPoint. "align with new line"
  3290.                 lines addLast: aLine.
  3291.                  destination _ self getEndingPoint: aLine from: source toCondition: toCondition bothCondition: bothCondition]].
  3292.  
  3293.     self eraseNewPath: lines in: view insetDisplayBox.
  3294.  
  3295.     ((destination isNil) | (aLine isNil))
  3296.          ifTrue: [^nil].    "Quit or same FoibleBox - abort"
  3297.  
  3298.     lines _ self fixLastLine: lines toBox: destination.
  3299.  
  3300.     ^ ProtoLink new origin: source destination: destination lines: lines!
  3301.  
  3302. straightLiner: oldLine width: width
  3303.     " Allow the user to designate a line segment, aware of the eventual width of the line"
  3304.  
  3305.     | point aSession |
  3306.     point _ self cursorInView: view linkWidth: width.
  3307.     aSession _ LineDrawingSession firstLine: oldLine atCursor: point using: self defaultLineClass.
  3308.  
  3309.     aSession redrawAt: point displayIn: view.
  3310.  
  3311.     [Sensor noButtonPressed] whileTrue:
  3312.         [point _ self cursorInView: view linkWidth: width.
  3313.         aSession cursorAt: point displayIn: view].
  3314.  
  3315.     aSession redrawAt: point displayIn: view.
  3316.  
  3317.     (Sensor redButtonPressed) 
  3318.         ifFalse: [^nil].
  3319.     Sensor waitNoButton.    "avoid the click that leads to menus"
  3320.     ^aSession lastLine! !
  3321.  
  3322.  
  3323. !Tool methodsFor: 'layout messages'!
  3324.  
  3325. open
  3326.     "Ask for a filename, and make the model the result of reading
  3327.         the structure in that file"
  3328.     | aName aFoibleProgram |
  3329.  
  3330.     aName _ (FillInTheBlank request: 'Open what layout file?') asFileName.
  3331.  
  3332.     (aName = '') ifTrue: [^nil].
  3333.  
  3334.     (TekSystemCall existingName: aName) 
  3335.         ifFalse:[^PopUpNotifier message: aName, ' does not exist.'].
  3336.  
  3337.     Cursor wait show.
  3338.     aFoibleProgram _ FoibleProgram readStructureFromFile: aName.
  3339.     model cursor show.
  3340.     
  3341.     (view superView class) openOn: aFoibleProgram.!
  3342.  
  3343. save
  3344.     "Ask for a filename, and save the model in that file"
  3345.  
  3346.     | aName stream result |
  3347.     aName _ (FillInTheBlank request: 'Save in what file?' initialAnswer: (self program name,'.stbin') asFileName) asFileName.
  3348.     aName = '' ifTrue: [^nil].
  3349.     (TekSystemCall existingName: aName)
  3350.         ifTrue: 
  3351.             [result _ BinaryChoice message: 'File ' , aName , ' already exists.
  3352. Do you want to overwrite it?'.
  3353.             result ifFalse: [^nil]].
  3354.     Cursor wait show. 
  3355.     self program storeStructureOnFile: aName. 
  3356.     model cursor show! !
  3357.  
  3358. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3359.  
  3360. Tool class
  3361.     instanceVariableNames: 'toolCursor icon '!
  3362. Tool class comment:
  3363. 'Class instance varibles:
  3364. - toolCursor - cursor to be displayed when this tool is activated.
  3365. - icon -     icon to be displayed (in palette of icons on left side of layout
  3366.             window) when this tool is activated. A tool is activated by
  3367.             selecting its icon from the palette of icons.'!
  3368.  
  3369.  
  3370. !Tool class methodsFor: 'class initialization'!
  3371.  
  3372. initialize
  3373.     "Tool initialize"
  3374.  
  3375.     toolCursor _ Cursor normal.!
  3376.  
  3377. initializeForms
  3378.     " send this class method when the form for my icon or cursor has been changed "
  3379.     " <class name> initializeForms "
  3380.  
  3381.     icon _ self getIcon.
  3382.     toolCursor _ self getCursor offset: self cursorOffset! !
  3383.  
  3384.  
  3385. !Tool class methodsFor: 'form access'!
  3386.  
  3387. getCursor
  3388.     "ask IconManager to get the form for my cursor"
  3389.  
  3390.     ^ self getCursor: self name,'.cur'!
  3391.  
  3392. getCursor: iconName
  3393.     "ask IconManager to get the cursor with name aName"
  3394.  
  3395.     ^ IconManager getCursor: iconName fromDirectory: self iconDirectory!
  3396.  
  3397. getIcon
  3398.     "ask IconManager to get the form for my icon"
  3399.  
  3400.     ^ self getIcon: self name,'.icn'!
  3401.  
  3402. getIcon: iconName
  3403.     "ask IconManager to get the icon with name aName"
  3404.  
  3405.     ^ IconManager getIcon: iconName fromDirectory: self iconDirectory!
  3406.  
  3407. iconDirectory
  3408.     "return the directory that contains the icons for my icon"
  3409.  
  3410.     self subclassResponsibility! !
  3411.  
  3412.  
  3413. !Tool class methodsFor: 'accessing'!
  3414.  
  3415. cursor
  3416.     "Return toolCursor"
  3417.  
  3418.     toolCursor isNil ifTrue: [toolCursor _ self getCursor offset: self cursorOffset].
  3419.     ^toolCursor!
  3420.  
  3421. cursorOffset
  3422.     "Return the offset of my cursor"
  3423.  
  3424.     ^0@0!
  3425.  
  3426. icon   
  3427.     " return Tool's icon for the palette"
  3428.  
  3429.     icon isNil ifTrue: [icon _ self getIcon].
  3430.     ^icon! !
  3431.  
  3432.  
  3433. Tool initialize!
  3434.  
  3435.  
  3436. Tool subclass: #NullTool
  3437.     instanceVariableNames: ''
  3438.     classVariableNames: ''
  3439.     poolDictionaries: ''
  3440.     category: 'Foible'!
  3441. NullTool comment:
  3442. 'I am the concrete class for Tools that do nothing. I serve as a 
  3443. placeholder in a canvas.'!
  3444.  
  3445.  
  3446. !NullTool methodsFor: 'menu setup'!
  3447.  
  3448. installMenu
  3449.     "Install our menu"
  3450.  
  3451.     controller yellowButtonMenu: nil
  3452.         yellowButtonMessages: nil! !
  3453.  
  3454. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3455.  
  3456. NullTool class
  3457.     instanceVariableNames: ''!
  3458.  
  3459.  
  3460. !NullTool class methodsFor: 'form access'!
  3461.  
  3462. iconDirectory
  3463.     "return the directory that contains the icons for FlowKit"
  3464.  
  3465.     ^FoibleDirectory iconDirectory! !
  3466.  
  3467.  
  3468. View subclass: #CanvasView
  3469.     instanceVariableNames: 'tools '
  3470.     classVariableNames: ''
  3471.     poolDictionaries: ''
  3472.     category: 'Foible'!
  3473. CanvasView comment:
  3474. 'I am the View of a canvas in a visual program. I can update the entire 
  3475. canvas area, or just a specified area.
  3476.    
  3477. Instance Variables:
  3478.  
  3479.     tools <OrderedCollection>
  3480.         a collection of Tools. when a new tool is selected from the Palette, 
  3481.         my ToolBenchView tells me which Tool in the collection to install, 
  3482.         and I tell my controller to install it.'!
  3483.  
  3484.  
  3485. !CanvasView methodsFor: 'displaying'!
  3486.  
  3487. displayView
  3488.     "Subclasses should redefine View|displayView in order to    
  3489.     display particular objects associated with the View such as  
  3490.      labels, lines, boxes, etc."
  3491.  
  3492.     ^self displayViewClippingBox: self insetDisplayBox!
  3493.  
  3494. displayViewClippingBox: aRect 
  3495.     "Display the portion of the model that is within the rectangle"
  3496.  
  3497.     self clearInside: Form white rect: aRect.
  3498.     ^model
  3499.         displayOn: Display
  3500.         at: self insetDisplayBox origin
  3501.         clippingBox: aRect!
  3502.  
  3503. displayViewClippingBoxNoRefresh: aRect 
  3504.     "Display the portion of the model that is within the rectangle 
  3505.     without clearing first. (Needed for smooth redisplay of 
  3506.     graphic i/o boxes.)"
  3507.  
  3508.     ^model
  3509.         displayOn: Display
  3510.         at: self insetDisplayBox origin
  3511.         clippingBox: aRect! !
  3512.  
  3513.  
  3514. !CanvasView methodsFor: 'updating'!
  3515.  
  3516. update: aRect 
  3517.     "We always update a region of the screen."
  3518.  
  3519.     aRect class == Rectangle ifFalse: [^self error: 'not a rectangle'].
  3520.     ^self displayViewClippingBox: (aRect translateBy: self insetDisplayBox origin)!
  3521.  
  3522. update: aParm with: aRect 
  3523.     "always update a region of the screen. If aParm is a symbol, 
  3524.     update without refresh. Otherwise, use standard update."
  3525.  
  3526.     aParm == #value
  3527.         ifTrue: 
  3528.             [aRect class == Rectangle ifFalse: [^self error: 'not a rectangle'].
  3529.             ^self displayViewClippingBoxNoRefresh: 
  3530.                             (aRect translateBy: self insetDisplayBox origin)]
  3531.         ifFalse: [self update: aParm]! !
  3532.  
  3533.  
  3534. !CanvasView methodsFor: 'clearing'!
  3535.  
  3536. clearInside: aColor rect: aRectangle 
  3537.     "Use aColor to paint the region aRectangle  of the receiver."
  3538.  
  3539.     aColor ~= nil ifTrue: [Display fill: aRectangle mask: aColor]! !
  3540.  
  3541.  
  3542. !CanvasView methodsFor: 'initialize'!
  3543.  
  3544. initialize
  3545.     tools _ OrderedCollection new.
  3546.     super initialize! !
  3547.  
  3548.  
  3549. !CanvasView methodsFor: 'private'!
  3550.  
  3551. addTools: toolCollection
  3552.  
  3553.     toolCollection do:
  3554.         [:each | tools add: each]!
  3555.  
  3556. installTool: toolIndex
  3557.     " a new tool has been selected from the palette, tell my controller to 
  3558.      install the new tool "
  3559.  
  3560.     self controller tool: (tools at: toolIndex)!
  3561.  
  3562. installToolClass: aClass
  3563.     " tell my controller to install a tool of aClass"
  3564.  
  3565.     | aTool |
  3566.     aTool _ tools detect: [:tool | tool isMemberOf: aClass].
  3567.     aTool isNil ifTrue: [^nil].
  3568.     self controller tool: aTool! !
  3569.  
  3570. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3571.  
  3572. CanvasView class
  3573.     instanceVariableNames: ''!
  3574.  
  3575.  
  3576. !CanvasView class methodsFor: 'instance creation'!
  3577.  
  3578. new
  3579.     | aCanvasView |
  3580.     aCanvasView _ super new.
  3581.     aCanvasView initialize.
  3582.     ^aCanvasView! !
  3583.  
  3584.  
  3585. StandardSystemView subclass: #FoibleView
  3586.     instanceVariableNames: ''
  3587.     classVariableNames: ''
  3588.     poolDictionaries: ''
  3589.     category: 'Foible'!
  3590. FoibleView comment:
  3591. 'I am the top-level view (in the model-view-controller triad) for any visual
  3592. program or environment written using Foible code. I am needed, because
  3593. the top-level View must be a subclass of of SyandardSystemView (to 
  3594. handle resizing the window, etc.), and ToolBenchView is now a subclass of 
  3595. View.
  3596.  
  3597. An instance of ToolBenchView should be my only subView. Canvases are 
  3598. subViews of a ToolBenchView.
  3599. '!
  3600.  
  3601.  
  3602. !FoibleView methodsFor: 'framing'!
  3603.  
  3604. resize
  3605.     "Determine the rectangular area for the receiver, adjusted to the minimum
  3606.     and maximum sizes."
  3607.  
  3608.     | aRectangle |
  3609.     aRectangle _ self getFrame.
  3610.     aRectangle _ aRectangle origin extent:
  3611.                     ((aRectangle extent max: minimumSize) min: maximumSize).
  3612.     self window: (aRectangle deepCopy moveTo: 0@0) viewport: aRectangle.
  3613.     self firstSubView window: self window viewport: self window! !
  3614.  
  3615.  
  3616. !FoibleView methodsFor: 'label access'!
  3617.  
  3618. label: aString style: aTextStyle 
  3619.     "Change the name of the FoibleProgram when the label is changed"
  3620.  
  3621.     super label: aString style: aTextStyle.
  3622.     model notNil ifTrue: [self model name: aString]! !
  3623.  
  3624.  
  3625. View subclass: #ToolBenchView
  3626.     instanceVariableNames: 'canvas '
  3627.     classVariableNames: ''
  3628.     poolDictionaries: ''
  3629.     category: 'Foible'!
  3630. ToolBenchView comment:
  3631. 'I am the View that manages the canvases in an application.  There is one
  3632. canvasView for each canvas. The canvasViews are my subViews.
  3633.  
  3634. Instance variables:
  3635.  
  3636.     canvas <OrderedCollection>
  3637.         a collection of canvasViews, one for each canvas in an application.'!
  3638.  
  3639.  
  3640. !ToolBenchView methodsFor: 'transforming'!
  3641.  
  3642. window: aWindow viewport: aViewport 
  3643.     "Set the receiver's window to aWindow, set its viewport to aViewport, 
  3644.     and create a new local transformation for the receiver based on 
  3645.     aWindow and aViewport. The receiver is scaled and translated so that 
  3646.     aWindow, when transformed, coincides with aViewport. 
  3647.     It is used to position a subView's window within some specific region of     its superView's area. For example, 'subView window: aRectangle1 
  3648.     viewport: aRectangle2' sets subView's window to aRectangle1, its 
  3649.     viewport to aRectangle2, and its local transformation to one that 
  3650.     transforms aRectangle1 to aRectangle2."
  3651.     | viewBounds canvasWindow canvasViewPort canvasExtent backViewPort numViews upperLeft |
  3652.  
  3653.     self window: aWindow.
  3654.     self setTransformation:
  3655.         (WindowingTransformation window: aWindow viewport: aViewport).
  3656.     self getViewport.
  3657.  
  3658.     canvasExtent _ self window extent.
  3659.     numViews _ self canvas size.
  3660.     canvasExtent _ canvasExtent x // numViews @ canvasExtent y.
  3661.     canvasWindow _ Rectangle origin: 0@0 extent: canvasExtent.
  3662.     upperLeft _ 0@0.
  3663.     self canvas do:
  3664.         [:each |
  3665.         canvasViewPort _ Rectangle origin: upperLeft extent: canvasExtent.
  3666.         upperLeft _ canvasViewPort topRight.
  3667.         each window: canvasWindow viewport: canvasViewPort]! !
  3668.  
  3669.  
  3670. !ToolBenchView methodsFor: 'initialize'!
  3671.  
  3672. initializeWithModel: aFoibleProgram
  3673.     "Add the sub-view: the variable sized canvas (with a dummy form for now)"
  3674.  
  3675.     self model: aFoibleProgram.
  3676.     canvas _ OrderedCollection with: ((CanvasView new model: aFoibleProgram firstManager) 
  3677.                 borderWidth: 1).
  3678.     self addSubView: canvas first! !
  3679.  
  3680.  
  3681. !ToolBenchView methodsFor: 'private'!
  3682.  
  3683. canvas
  3684.     "Return the 'canvas' subviews"
  3685.  
  3686.     ^self subclassResponsibility!
  3687.  
  3688. installCanvasTools
  3689.  
  3690.     ^self subclassResponsibility!
  3691.  
  3692. installTool: toolIndex
  3693.     " tell each of my canvases to install the new Tool"
  3694.  
  3695.     1 to: self canvas size do:
  3696.         [:each | (self canvas at: each) installTool: toolIndex]!
  3697.  
  3698. tools
  3699.     "return an OrderdCollection of the icons for the palette"
  3700.  
  3701.     ^self subclassResponsibility! !
  3702.  
  3703.  
  3704. !ToolBenchView methodsFor: 'controller access'!
  3705.  
  3706. canvasController
  3707.     "Return the controllers for the canvas"
  3708.  
  3709.     ^self canvas collect: [:each | each controller]!
  3710.  
  3711. canvasController: aBlock 
  3712.     "Set up the controllers for the canvas by evaluating aBlock"
  3713.  
  3714.     1 to: self canvas size do: [:each | (self canvas at: each)
  3715.             controller: aBlock value]!
  3716.  
  3717. defaultControllerClass
  3718.     ^PaletteController! !
  3719.  
  3720. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3721.  
  3722. ToolBenchView class
  3723.     instanceVariableNames: ''!
  3724.  
  3725.  
  3726. !ToolBenchView class methodsFor: 'instance creation'!
  3727.  
  3728. model: aCollectionOfModels
  3729.     "Create an instance of me that uses aCollectionOfModels as the canvases models"
  3730.  
  3731.     | view | 
  3732.     view _ super new.
  3733.     view initializeWithModel: aCollectionOfModels.
  3734.     ^view!
  3735.  
  3736. open
  3737.     "Create a new FoibleProgram and open a ToolBenchView on it"
  3738.  
  3739.     self openOn: (FoibleProgram with: FoibleManager new)!
  3740.  
  3741. openOn: aFoibleProgram 
  3742.     "Create and install views of aFoibleProgram and their menu."
  3743.  
  3744.     | toolBenchView topView |
  3745.     toolBenchView _ self model: aFoibleProgram.
  3746.     toolBenchView canvasController: [CanvasController new].
  3747.     toolBenchView insideColor: Form gray.
  3748.     toolBenchView installCanvasTools.
  3749.     topView _ FoibleView new
  3750.         model: aFoibleProgram;
  3751.         label: aFoibleProgram name;
  3752.         addSubView: toolBenchView in: (0@0 extent: 1@1) borderWidth: 0.
  3753.     topView minimumSize: 200@400.
  3754.     topView controller open!
  3755.  
  3756. openProgram
  3757.     "Open an existing program; saved as a binary"
  3758.     "ToolBenchView openProgram."
  3759.  
  3760.     | aFileName |
  3761.     aFileName _ (FileDirectory currentDirectory)
  3762.                 requestFileName: 'Which layout do you want to open?'
  3763.                 default: '*.stbin'
  3764.                 version: #any
  3765.                 ifFail: [^nil].
  3766.     (TekSystemCall existingName: aFileName)
  3767.         ifFalse: [^PopUpNotifier message: aFileName , ' does not exist.'].
  3768.     self openOn: (FoibleProgram readStructureFromFile: aFileName)!
  3769.  
  3770. openProgram: aName 
  3771.     "Open an existing program saved as a binary"
  3772.     "ToolBenchView openProgram: <aName>."
  3773.  
  3774.     | aFileName |
  3775.     aFileName _ aName asFileName.
  3776.     (TekSystemCall existingName: aFileName)
  3777.         ifFalse: [^PopUpNotifier message: aFileName , ' does not exist.'].
  3778.     self openOn: (FoibleProgram readStructureFromFile: aFileName)! !
  3779.  
  3780.